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

1553 lines
66 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-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: modes.m.
% Main author: fjh.
%
% This module contains the top level of the code for mode checking and mode
% inference.
%
% Basically what this module does is to traverse the HLDS, performing
% mode-checking or mode inference on each predicate. For each procedure, it
% will reorder the procedure body if necessary, annotate each sub_goal with
% its mode, and check that the procedure body is mode-correct,
% This pass also determines whether or not unifications can fail. It
% also converts unifications with higher-order predicate terms into
% unifications with lambda expressions.
%
% The input to this pass must be type-correct and in superhomogeneous form.
%
% This pass does not check that `unique' modes are not used in contexts
% which might require backtracking - that is done by unique_modes.m.
% N.B. Changes here may also require changes to unique_modes.m!
%
% IMPLEMENTATION DOCUMENTATION
% How does it all work? Well, mode checking/inference is basically a
% process of abstract interpretation. To perform this abstract
% interpretation on a procedure body, we need to know the initial insts of
% the arguments; then we can abstractly interpret the goal to compute the
% final insts. For mode checking, we then just compare the inferred final
% insts with the declared final insts, and that's about all there is to it.
%
% For mode inference, it's a little bit trickier. When we see a call to a
% predicate for which the modes weren't declared, we first check whether the
% call matches any of the modes we've already inferred. If not, we create a
% new mode for the predicate, with the initial insts set to a "normalised"
% version of the insts of the call arguments. For a first approximation, we
% set the final insts to `not_reached'. What this means is that we don't
% yet have any information about what the final insts will be. We then keep
% iterating mode inference passes until we reach a fixpoint.
%
% To mode-analyse a procedure:
% 1. Initialize the insts of the head variables.
% 2. Mode-analyse the goal.
% 3. a. If we're doing mode-checking:
% Check that the final insts of the head variables
% matches that specified in the mode declaration
% b. If we're doing mode-inference:
% Normalise the final insts of the head variables,
% record the newly inferred normalised final insts
% in the proc_info, and check whether they changed
% (so that we know when we've reached the fixpoint).
%
% How to mode-analyse a goal is documented at the top of modecheck_goal.
%
%-----------------------------------------------------------------------------%
:- module check_hlds.modes.
:- interface.
:- import_module check_hlds.mode_info.
:- import_module hlds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.
:- import_module parse_tree.error_util.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.prog_data.
:- import_module bool.
:- import_module list.
%-----------------------------------------------------------------------------%
% modecheck_module(!.HLDS, {!:HLDS, SafeToContinue, Specs}):
%
% Perform mode inference and checking for a whole module.
%
% SafeToContinue = unsafe_to_continue means that mode inference
% was halted prematurely due to an error, and that we should therefore
% not perform determinism-checking, because we might get internal errors.
%
% The outputs are in a tuple because our caller wants to be able to
% benchmark mode analysis, and the benchmark predicates require exactly
% one output argument.
%
:- pred modecheck_module(module_info::in,
{module_info, maybe_safe_to_continue, list(error_spec)}::out) is det.
% Mode-check or unique-mode-check the code of all the predicates
% in a module.
%
:- pred check_pred_modes(how_to_check_goal::in, may_change_called_proc::in,
module_info::in, module_info::out, maybe_safe_to_continue::out,
list(error_spec)::out) is det.
% Mode-check the code for the given predicate in a given mode.
% Returns the number of errs found and a bool `Changed'
% which is true iff another pass of fixpoint analysis may be needed.
%
:- pred modecheck_proc(proc_id::in, pred_id::in,
module_info::in, module_info::out, list(error_spec)::out,
bool::out) is det.
% Mode-check or unique-mode-check the code for the given predicate
% in a given mode.
% Returns the number of errs found and a bool `Changed'
% which is true iff another pass of fixpoint analysis may be needed.
%
:- pred modecheck_proc_general(proc_id::in, pred_id::in, how_to_check_goal::in,
may_change_called_proc::in, module_info::in, module_info::out,
list(error_spec)::out, bool::out) is det.
% Check that the final insts of the head vars of a lambda goal
% matches their expected insts.
%
:- pred modecheck_lambda_final_insts(list(prog_var)::in, list(mer_inst)::in,
hlds_goal::in, hlds_goal::out, mode_info::in, mode_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.clause_to_proc.
:- import_module check_hlds.cse_detection.
:- import_module check_hlds.delay_partial_inst.
:- import_module check_hlds.det_analysis.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.introduce_exists_casts.
:- import_module check_hlds.mode_debug.
:- import_module check_hlds.mode_errors.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.modecheck_goal.
:- import_module check_hlds.modecheck_util.
:- import_module check_hlds.proc_requests.
:- import_module check_hlds.switch_detection.
:- import_module check_hlds.type_util.
:- import_module check_hlds.unique_modes.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.instmap.
:- import_module hlds.make_goal.
:- import_module hlds.passes_aux.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module hlds.vartypes.
:- import_module libs.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.set_of_var.
:- import_module assoc_list.
:- import_module bag.
:- import_module int.
:- import_module io.
:- import_module map.
:- import_module maybe.
:- import_module queue.
:- import_module require.
:- import_module set_tree234.
:- import_module string.
:- import_module term.
%-----------------------------------------------------------------------------%
modecheck_module(ModuleInfo0, {ModuleInfo, SafeToContinue, Specs}) :-
check_pred_modes(check_modes, may_change_called_proc,
ModuleInfo0, ModuleInfo, SafeToContinue, Specs).
%-----------------------------------------------------------------------------%
check_pred_modes(WhatToCheck, MayChangeCalledProc, !ModuleInfo,
SafeToContinue, !:Specs) :-
module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_int_option(Globals, mode_inference_iteration_limit,
MaxIterations),
modecheck_to_fixpoint(PredIds, MaxIterations, WhatToCheck,
MayChangeCalledProc, !ModuleInfo, SafeToContinue0, !:Specs),
(
WhatToCheck = check_unique_modes,
report_mode_inference_messages_for_preds(!.ModuleInfo,
include_detism_on_modes, PredIds, !Specs),
check_eval_methods(!.ModuleInfo, !Specs),
SafeToContinue = SafeToContinue0
;
WhatToCheck = check_modes,
(
SafeToContinue0 = unsafe_to_continue,
report_mode_inference_messages_for_preds(!.ModuleInfo,
do_not_include_detism_on_modes, PredIds, !Specs),
SafeToContinue = unsafe_to_continue
;
SafeToContinue0 = safe_to_continue,
globals.lookup_bool_option(Globals, delay_partial_instantiations,
DelayPartialInstantiations),
(
DelayPartialInstantiations = yes,
BeforeDPISafeToContinue = SafeToContinue0,
BeforeDPISpecs = !.Specs,
BeforeDPIModuleInfo = !.ModuleInfo,
delay_partial_inst_preds(PredIds, ChangedPreds, !ModuleInfo),
% --delay-partial-instantiations requires mode checking to be
% run again.
modecheck_to_fixpoint(ChangedPreds, MaxIterations, WhatToCheck,
MayChangeCalledProc, !.ModuleInfo, AfterDPIModuleInfo,
AfterDPISafeToContinue, AfterDPISpecs),
MaybeBeforeDPISeverity =
worst_severity_in_specs(Globals, BeforeDPISpecs),
MaybeAfterDPISeverity =
worst_severity_in_specs(Globals, AfterDPISpecs),
% BeforeDPISpecs and AfterDPISpecs ought to be the same,
% but in its current form, delay_partial_inst can also
% INTRODUCE mode errors. This can happen in situations where
% a predicate (such as the original version of the
% get_feedback_data predicate in feedback.m in the
% mdbcomp directory) REQUIRES being passed a partially
% instantiated term.
%
% Ideally, we would apply the delay_partial_inst transformation
% to the predicates where it does not cause problems, and
% undo it in the predicates where it does. Unfortunately,
% in the presence of mode inference, separating the two
% categories is not easy, so if delay_partial_inst causes ANY
% new problems, from ANY predicate, we undo ALL its updates.
(
MaybeBeforeDPISeverity = no,
MaybeAfterDPISeverity = no,
% There is no difference; BeforeDPISpecs and AfterDPISpecs
% are equivalent. Pick one.
!:Specs = AfterDPISpecs,
!:ModuleInfo = AfterDPIModuleInfo,
SafeToContinue = AfterDPISafeToContinue
;
MaybeBeforeDPISeverity = no,
MaybeAfterDPISeverity = yes(_),
% delay_partial_inst introduced a problem. Undo its effect.
!:Specs = BeforeDPISpecs,
!:ModuleInfo = BeforeDPIModuleInfo,
SafeToContinue = BeforeDPISafeToContinue
;
MaybeBeforeDPISeverity = yes(_),
MaybeAfterDPISeverity = no,
% delay_partial_inst fixed a problem. Keep its effect.
!:Specs = AfterDPISpecs,
!:ModuleInfo = AfterDPIModuleInfo,
SafeToContinue = AfterDPISafeToContinue
;
MaybeBeforeDPISeverity = yes(BeforeDPISeverity),
MaybeAfterDPISeverity = yes(AfterDPISeverity),
WorstSeverity =
worst_severity(BeforeDPISeverity, AfterDPISeverity),
% We do not have a COUNT of the number of problems
% in either BeforeDPISpecs or AfterDPISpecs, so we
% cannot choose the one that reports fewer problems.
% However, to a large extent that does not matter,
% because what we actually want to minimize is the
% total COMPLEXITY of the mode problems we report
% to the user, and a single complex mode error can be
% as hard to understand as several simpler ones.
%
% If the delay_partial_inst transformation does not fix
% all the mode errors in the module (without necessarily
% fixing all the warnings), then we prefer to go with
% the untransformed version of the errors, since these
% should be easier to relate to the code as written.
( if AfterDPISeverity = WorstSeverity then
!:Specs = BeforeDPISpecs,
!:ModuleInfo = BeforeDPIModuleInfo,
SafeToContinue = BeforeDPISafeToContinue
else
!:Specs = AfterDPISpecs,
!:ModuleInfo = AfterDPIModuleInfo,
SafeToContinue = AfterDPISafeToContinue
)
)
;
DelayPartialInstantiations = no,
SafeToContinue = safe_to_continue
)
)
).
% Iterate over the list of pred_ids in a module.
%
:- pred modecheck_to_fixpoint(list(pred_id)::in, int::in,
how_to_check_goal::in, may_change_called_proc::in,
module_info::in, module_info::out, maybe_safe_to_continue::out,
list(error_spec)::out) is det.
modecheck_to_fixpoint(PredIds, MaxIterations, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, SafeToContinue, !:Specs) :-
% Save the old procedure bodies so that we can restore them for the
% next pass.
module_info_get_preds(!.ModuleInfo, OldPredTable0),
% Analyze every procedure that has its "CanProcess" flag
% set to `can_process_now'.
list.foldl3(maybe_modecheck_pred(WhatToCheck, MayChangeCalledProc),
PredIds, !ModuleInfo, no, Changed1, [], !:Specs),
% Analyze the procedures whose "CanProcess" flag was cannot_process_yet;
% those procedures were inserted into the unify requests queue.
modecheck_queued_procs(WhatToCheck, OldPredTable0, OldPredTable,
!ModuleInfo, Changed1, Changed, !Specs),
module_info_get_globals(!.ModuleInfo, Globals),
ErrorsSoFar = contains_errors(Globals, !.Specs),
(
Changed = no,
% Stop if we have reached a fixpoint.
SafeToContinue = safe_to_continue
;
Changed = yes,
(
ErrorsSoFar = yes,
% Stop if we have found any errors.
SafeToContinue = unsafe_to_continue
;
ErrorsSoFar = no,
( if MaxIterations =< 1 then
% Stop if we have exceeded the iteration limit.
MaxIterSpec = report_max_iterations_exceeded(!.ModuleInfo),
!:Specs = [MaxIterSpec | !.Specs],
SafeToContinue = unsafe_to_continue
else
% Otherwise, continue iterating.
globals.lookup_bool_option(Globals, debug_modes, DebugModes),
(
DebugModes = yes,
report_mode_inference_messages_for_preds(!.ModuleInfo,
do_not_include_detism_on_modes, PredIds,
[], InferenceSpecs),
trace [io(!IO)] (
io.write_string("Inferences by current iteration:\n",
!IO),
write_error_specs(InferenceSpecs, Globals,
0, _NumWarnings, 0, _NumErrors, !IO),
io.write_string("End of inferences.\n", !IO)
)
;
DebugModes = no
),
% Mode analysis may have modified the procedure bodies,
% since it does some optimizations such as deleting unreachable
% code. But since we didn't reach a fixpoint yet, the mode
% information is not yet correct, and so those optimizations
% will have been done based on incomplete information, and so
% they may produce incorrect results. We thus need to restore
% the old procedure bodies.
(
WhatToCheck = check_modes,
% Restore the proc_info goals from the clauses in the
% pred_info. Reintroduce exists_cast goals, since these
% do not appear in the clauses.
copy_clauses_to_nonmethod_procs_for_preds_in_module_info(
PredIds, !ModuleInfo),
introduce_exists_casts(PredIds, !ModuleInfo)
;
WhatToCheck = check_unique_modes,
% Restore the proc_info goals from the
% proc_infos in the old module_info.
% XXX Why don't we do the same for check_modes?
copy_pred_bodies(OldPredTable, PredIds, !ModuleInfo)
),
MaxIterations1 = MaxIterations - 1,
modecheck_to_fixpoint(PredIds, MaxIterations1, WhatToCheck,
MayChangeCalledProc, !ModuleInfo, SafeToContinue, !:Specs)
)
)
).
:- func report_max_iterations_exceeded(module_info) = error_spec.
report_max_iterations_exceeded(ModuleInfo) = Spec :-
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_int_option(Globals, mode_inference_iteration_limit,
MaxIterations),
Pieces = [words("Mode analysis iteration limit exceeded."), nl,
words("You may need to declare the modes explicitly"),
words("or use the"), quote("--mode-inference-iteration-limit"),
words("option to increase the limit."),
words("(The current limit is"), int_fixed(MaxIterations),
words("iterations.)"), nl],
Msg = error_msg(no, do_not_treat_as_first, 0, [always(Pieces)]),
Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
[Msg]).
% copy_pred_bodies(OldPredTable, ProcId, ModuleInfo0, ModuleInfo):
%
% Copy the procedure bodies for all procedures of the specified PredIds
% from OldPredTable into ModuleInfo0, giving ModuleInfo.
%
:- pred copy_pred_bodies(pred_table::in, list(pred_id)::in,
module_info::in, module_info::out) is det.
copy_pred_bodies(OldPredTable, PredIds, !ModuleInfo) :-
module_info_get_preds(!.ModuleInfo, PredTable0),
list.foldl(copy_pred_body(OldPredTable), PredIds, PredTable0, PredTable),
module_info_set_preds(PredTable, !ModuleInfo).
% copy_pred_body(OldPredTable, ProcId, PredTable0, PredTable):
%
% Copy the procedure bodies for all procedures of the specified PredId
% from OldPredTable into PredTable0, giving PredTable.
%
:- pred copy_pred_body(pred_table::in, pred_id::in,
pred_table::in, pred_table::out) is det.
copy_pred_body(OldPredTable, PredId, PredTable0, PredTable) :-
map.lookup(PredTable0, PredId, PredInfo0),
( if
% Don't copy type class methods, because their proc_infos are generated
% already mode-correct, and because copying from the clauses_info
% doesn't work for them.
pred_info_get_markers(PredInfo0, Markers),
check_marker(Markers, marker_class_method)
then
PredTable = PredTable0
else
pred_info_get_proc_table(PredInfo0, ProcTable0),
map.lookup(OldPredTable, PredId, OldPredInfo),
pred_info_get_proc_table(OldPredInfo, OldProcTable),
map.keys(OldProcTable, OldProcIds),
list.foldl(copy_proc_body(OldProcTable), OldProcIds,
ProcTable0, ProcTable),
pred_info_set_proc_table(ProcTable, PredInfo0, PredInfo),
map.det_update(PredId, PredInfo, PredTable0, PredTable)
).
% copy_proc_body(OldProcTable, ProcId, !ProcTable):
%
% Copy the body of the specified ProcId from OldProcTable into !ProcTable.
%
:- pred copy_proc_body(proc_table::in, proc_id::in,
proc_table::in, proc_table::out) is det.
copy_proc_body(OldProcTable, ProcId, !ProcTable) :-
map.lookup(OldProcTable, ProcId, OldProcInfo),
proc_info_get_goal(OldProcInfo, OldProcBody),
map.lookup(!.ProcTable, ProcId, ProcInfo0),
proc_info_set_goal(OldProcBody, ProcInfo0, ProcInfo),
map.det_update(ProcId, ProcInfo, !ProcTable).
:- func should_modecheck_pred(pred_info) = bool.
should_modecheck_pred(PredInfo) = ShouldModeCheck :-
( if
(
% Don't modecheck imported predicates.
( pred_info_is_imported(PredInfo)
; pred_info_is_pseudo_imported(PredInfo)
)
;
% Don't modecheck class methods, because they are generated
% already mode-correct and with correct instmap deltas.
pred_info_get_markers(PredInfo, PredMarkers),
check_marker(PredMarkers, marker_class_method)
)
then
ShouldModeCheck = no
else
ShouldModeCheck = yes
).
:- pred maybe_modecheck_pred(how_to_check_goal::in, may_change_called_proc::in,
pred_id::in, module_info::in, module_info::out, bool::in, bool::out,
list(error_spec)::in, list(error_spec)::out) is det.
maybe_modecheck_pred(WhatToCheck, MayChangeCalledProc, PredId,
!ModuleInfo, !Changed, !Specs) :-
module_info_get_preds(!.ModuleInfo, Preds0),
map.lookup(Preds0, PredId, PredInfo0),
ShouldModeCheck = should_modecheck_pred(PredInfo0),
(
ShouldModeCheck = no
;
ShouldModeCheck = yes,
trace [io(!IO)] (
write_modes_progress_message(!.ModuleInfo, WhatToCheck,
PredId, PredInfo0, !IO)
),
do_modecheck_pred(PredId, PredInfo0, WhatToCheck,
MayChangeCalledProc, !ModuleInfo, !Changed,
ThisPredDeclSpecs, ThisPredProcSpecs),
!:Specs = ThisPredDeclSpecs ++ ThisPredProcSpecs ++ !.Specs,
% The lack of a mode declaration for the predicate is not a reason
% to stop mode inference on the predicate. That is why we check for
% errors only in ThisPredProcSpecs, not in ThisPredDeclSpecs.
module_info_get_globals(!.ModuleInfo, Globals),
ContainsError = contains_errors(Globals, ThisPredProcSpecs),
(
ContainsError = yes,
module_info_make_pred_id_invalid(PredId, !ModuleInfo)
;
ContainsError = no
),
globals.lookup_bool_option(Globals, detailed_statistics, Statistics),
trace [io(!IO)] (
maybe_report_stats(Statistics, !IO)
)
).
:- pred write_modes_progress_message(module_info::in, how_to_check_goal::in,
pred_id::in, pred_info::in, io::di, io::uo) is det.
write_modes_progress_message(ModuleInfo, WhatToCheck, PredId, PredInfo, !IO) :-
pred_info_get_markers(PredInfo, Markers),
( if check_marker(Markers, marker_infer_modes) then
(
WhatToCheck = check_modes,
Msg = "% Mode-analysing "
;
WhatToCheck = check_unique_modes,
Msg = "% Unique-mode-analysing "
)
else
(
WhatToCheck = check_modes,
Msg = "% Mode-checking "
;
WhatToCheck = check_unique_modes,
Msg = "% Unique-mode-checking "
)
),
write_pred_progress_message(Msg, PredId, ModuleInfo, !IO).
%-----------------------------------------------------------------------------%
:- pred do_modecheck_pred(pred_id::in, pred_info::in,
how_to_check_goal::in, may_change_called_proc::in,
module_info::in, module_info::out, bool::in, bool::out,
list(error_spec)::out, list(error_spec)::out) is det.
do_modecheck_pred(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, !Changed, DeclSpecs, ProcSpecs) :-
(
WhatToCheck = check_modes,
pred_info_get_proc_table(PredInfo0, ProcTable),
( if
some [ProcInfo] (
map.member(ProcTable, _ProcId, ProcInfo),
proc_info_get_maybe_declared_argmodes(ProcInfo, yes(_))
)
then
% There was at least one declared mode for this procedure.
DeclSpecs = []
else
% There were no declared modes for this procedure.
DeclSpecs = maybe_report_error_no_modes(!.ModuleInfo, PredId,
PredInfo0)
)
;
WhatToCheck = check_unique_modes,
DeclSpecs = []
),
% Note that we use pred_info_procids rather than pred_info_all_procids
% here, which means that we don't process modes that have already been
% inferred as invalid.
ProcIds = pred_info_procids(PredInfo0),
modecheck_procs(ProcIds, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, !Changed, init_error_spec_accumulator, SpecsAcc),
ProcSpecs = error_spec_accumulator_to_list(SpecsAcc).
% Iterate over the list of modes for a predicate.
%
:- pred modecheck_procs(list(proc_id)::in, pred_id::in, how_to_check_goal::in,
may_change_called_proc::in, module_info::in, module_info::out,
bool::in, bool::out,
error_spec_accumulator::in, error_spec_accumulator::out) is det.
modecheck_procs([], _PredId, _, _, !ModuleInfo, !Changed, !Specs).
modecheck_procs([ProcId | ProcIds], PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, !Changed, !SpecsAcc) :-
% Mode-check that mode of the predicate.
maybe_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, !Changed, ProcSpecs),
accumulate_error_specs_for_proc(ProcSpecs, !SpecsAcc),
% Recursively process the remaining modes.
modecheck_procs(ProcIds, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, !Changed, !SpecsAcc).
%-----------------------------------------------------------------------------%
modecheck_proc(ProcId, PredId, !ModuleInfo, Specs, Changed) :-
modecheck_proc_general(ProcId, PredId, check_modes, may_change_called_proc,
!ModuleInfo, Specs, Changed).
modecheck_proc_general(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, Specs, Changed) :-
maybe_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, no, Changed, Specs).
:- pred maybe_modecheck_proc(proc_id::in, pred_id::in, how_to_check_goal::in,
may_change_called_proc::in, module_info::in, module_info::out,
bool::in, bool::out, list(error_spec)::out) is det.
maybe_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, !Changed, Specs) :-
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
PredInfo0, ProcInfo0),
proc_info_get_can_process(ProcInfo0, CanProcess),
(
CanProcess = cannot_process_yet,
Specs = []
;
CanProcess = can_process_now,
do_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, PredInfo0, ClausesInfo, ProcInfo0, ProcInfo,
!Changed, Specs),
% We get the pred_info from the ModuleInfo *again*, because
% while we are doing mode inference on one procedure of a predicate,
% we can add new mode declarations to that predicate. If we didn't
% refetch the pred_info, we would be implicitly undoing the addition
% of those new entries to the predicate's proc table.
module_info_pred_info(!.ModuleInfo, PredId, PredInfo1),
pred_info_get_proc_table(PredInfo1, ProcMap1),
map.det_update(ProcId, ProcInfo, ProcMap1, ProcMap),
pred_info_set_proc_table(ProcMap, PredInfo1, PredInfo2),
pred_info_set_clauses_info(ClausesInfo, PredInfo2, PredInfo),
module_info_get_preds(!.ModuleInfo, PredMap1),
map.det_update(PredId, PredInfo, PredMap1, PredMap),
module_info_set_preds(PredMap, !ModuleInfo)
).
:- pred do_modecheck_proc(proc_id::in, pred_id::in, how_to_check_goal::in,
may_change_called_proc::in, module_info::in, module_info::out,
pred_info::in, clauses_info::out, proc_info::in, proc_info::out,
bool::in, bool::out, list(error_spec)::out) is det.
do_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, PredInfo0, ClausesInfo, !ProcInfo,
!Changed, ErrorAndWarningSpecs) :-
pred_info_get_markers(PredInfo0, Markers),
( if check_marker(Markers, marker_infer_modes) then
InferModes = yes
else
InferModes = no
),
( if is_unify_pred(PredInfo0) then
IsUnifyPred = yes
else
IsUnifyPred = no
),
pred_info_get_origin(PredInfo0, Origin),
% We use the context of the first clause, unless there weren't any clauses
% at all, in which case we use the context of the mode declaration.
pred_info_get_clauses_info(PredInfo0, ClausesInfo0),
clauses_info_clauses(Clauses, _ItemNumbers, ClausesInfo0, ClausesInfo),
(
Clauses = [FirstClause | _],
Context = FirstClause ^ clause_context
;
Clauses = [],
proc_info_get_context(!.ProcInfo, Context)
),
% Extract the useful fields in the proc_info.
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_argmodes(!.ProcInfo, ArgModes0),
proc_info_arglives(!.ProcInfo, !.ModuleInfo, ArgLives0),
proc_info_get_goal(!.ProcInfo, Body0),
% Modecheck the body. First set the initial instantiation of the head
% arguments, then modecheck the body, and then check that the final
% instantiation matches that in the mode declaration.
some [!ModeInfo] (
% Construct the initial instmap.
mode_list_get_initial_insts(!.ModuleInfo, ArgModes0, ArgInitialInsts),
assoc_list.from_corresponding_lists(HeadVars, ArgInitialInsts, InstAL),
InstMap0 = instmap_from_assoc_list(InstAL),
% Construct the initial set of live vars:
% initially, only the non-clobbered head variables are live.
get_live_vars(HeadVars, ArgLives0, LiveVarsList),
set_of_var.list_to_set(LiveVarsList, LiveVars),
get_constrained_inst_vars(!.ModuleInfo, ArgModes0, HeadInstVars),
% Initialize the mode info.
mode_info_init(!.ModuleInfo, PredId, ProcId, Context, LiveVars,
HeadInstVars, InstMap0, WhatToCheck, MayChangeCalledProc,
!:ModeInfo),
mode_info_set_changed_flag(!.Changed, !ModeInfo),
mode_list_get_final_insts(!.ModuleInfo, ArgModes0, ArgFinalInsts0),
modecheck_proc_body(!.ModuleInfo, WhatToCheck, InferModes,
Markers, IsUnifyPred, PredId, ProcId, Body0, Body, HeadVars,
InstMap0, ArgFinalInsts0, ArgFinalInsts, !ModeInfo),
mode_info_get_errors(!.ModeInfo, ModeErrors),
(
InferModes = yes,
% For inferred predicates, we don't report the error(s) here;
% instead we just save them in the proc_info, thus marking that
% procedure as invalid.
proc_info_set_mode_errors(ModeErrors, !ProcInfo),
ErrorAndWarningSpecs = []
;
InferModes = no,
( if Origin = origin_mutable(_, _, _) then
% The only mode error that may occur in the automatically
% generated auxiliary predicates for a mutable is an
% invalid inst occurring in a mode, and we report a specific
% error message for that. Giving another, less direct
% description of the problem here would be confusing.
ErrorAndWarningSpecs = []
else
AllErrorSpecs = list.map(mode_error_info_to_spec(!.ModeInfo),
ModeErrors),
% We only return the first error, because there could be a
% large number of mode errors and usually only one is needed to
% diagnose the problem.
(
AllErrorSpecs = [ErrorSpec | _],
ErrorSpecs = [ErrorSpec],
proc_info_get_statevar_warnings(!.ProcInfo,
StateVarWarningSpecs)
;
AllErrorSpecs = [],
ErrorSpecs = [],
% If there were no errors, then ignore the informational
% messages generated by the state variable transformation.
StateVarWarningSpecs = []
),
mode_info_get_warnings(!.ModeInfo, ModeWarnings),
WarningSpecs = list.map(mode_warning_info_to_spec(!.ModeInfo),
ModeWarnings),
ErrorAndWarningSpecs = ErrorSpecs ++ WarningSpecs ++
StateVarWarningSpecs
)
),
% Save away the results.
inst_lists_to_mode_list(ArgInitialInsts, ArgFinalInsts, ArgModes),
mode_info_get_changed_flag(!.ModeInfo, !:Changed),
mode_info_get_module_info(!.ModeInfo, !:ModuleInfo),
mode_info_get_varset(!.ModeInfo, VarSet),
% VarTypes may differ from VarTypes0, since mode checking can
% add new variables (e.g. when handling calls in implied modes).
mode_info_get_var_types(!.ModeInfo, VarTypes),
mode_info_get_need_to_requantify(!.ModeInfo, NeedToRequantify),
proc_info_set_goal(Body, !ProcInfo),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
proc_info_set_argmodes(ArgModes, !ProcInfo),
(
NeedToRequantify = do_not_need_to_requantify
;
NeedToRequantify = need_to_requantify,
requantify_proc_general(ordinary_nonlocals_maybe_lambda, !ProcInfo)
)
).
:- pred modecheck_proc_body(module_info::in, how_to_check_goal::in,
bool::in, pred_markers::in, bool::in, pred_id::in, proc_id::in,
hlds_goal::in, hlds_goal::out, list(prog_var)::in, instmap::in,
list(mer_inst)::in, list(mer_inst)::out, mode_info::in, mode_info::out)
is det.
modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers, IsUnifyPred,
PredId, ProcId, Body0, Body, HeadVars, InstMap0,
ArgFinalInsts0, ArgFinalInsts, ModeInfo0, ModeInfo) :-
do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers,
IsUnifyPred, PredId, ProcId, Body0, Body1, HeadVars, InstMap0,
ArgFinalInsts0, ArgFinalInsts1, ModeInfo0, ModeInfo1),
mode_info_get_errors(ModeInfo1, ModeErrors1),
(
ModeErrors1 = [],
Body = Body1,
ArgFinalInsts = ArgFinalInsts1,
ModeInfo = ModeInfo1
;
ModeErrors1 = [_ | _],
mode_info_get_had_from_ground_term(ModeInfo1, HadFromGroundTerm),
(
HadFromGroundTerm = had_from_ground_term_scope,
% The error could have been due a ground term that we marked down
% as ground instead of unique. We therefore try again from the
% beginning, but this time, we tell the code that handles
% from_ground_term scopes to create unique terms.
%
% Note that this may be overkill. Even if e.g. the procedure has
% three from_ground_term_construct scopes, only one of which needs
% to be unique for mode analysis to succeed, we will call copy
% after all three. Fixing this would require a significantly more
% complicated approach.
mode_info_set_make_ground_terms_unique(make_ground_terms_unique,
ModeInfo0, ModeInfo2),
do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes,
Markers, IsUnifyPred, PredId, ProcId, Body0, Body, HeadVars,
InstMap0, ArgFinalInsts0, ArgFinalInsts, ModeInfo2, ModeInfo)
;
HadFromGroundTerm = did_not_have_from_ground_term_scope,
% The error could not have been due a ground term, so the results
% of the first analysis must stand.
Body = Body1,
ArgFinalInsts = ArgFinalInsts1,
ModeInfo = ModeInfo1
)
).
:- pred do_modecheck_proc_body(module_info::in, how_to_check_goal::in,
bool::in, pred_markers::in, bool::in, pred_id::in, proc_id::in,
hlds_goal::in, hlds_goal::out, list(prog_var)::in, instmap::in,
list(mer_inst)::in, list(mer_inst)::out, mode_info::in, mode_info::out)
is det.
do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers,
IsUnifyPred, PredId, ProcId, Body0, Body, HeadVars, InstMap0,
ArgFinalInsts0, ArgFinalInsts, !ModeInfo) :-
string.format("procedure_%d_%d",
[i(pred_id_to_int(PredId)), i(proc_id_to_int(ProcId))],
CheckpointMsg),
( if
InferModes = no,
check_marker(Markers, marker_mode_check_clauses),
Body0 = hlds_goal(BodyGoalExpr0, BodyGoalInfo0),
(
BodyGoalExpr0 = disj(Disjuncts0),
Disjuncts0 = [_ | _],
ClausesForm0 = clause_disj(Disjuncts0)
;
BodyGoalExpr0 = switch(SwitchVar0, CanFail0, Cases0),
Cases0 = [_ | _],
ClausesForm0 = clause_switch(SwitchVar0, CanFail0, Cases0)
),
BodyNonLocals = goal_info_get_nonlocals(BodyGoalInfo0),
mode_info_get_var_types(!.ModeInfo, VarTypes0),
SolverNonLocals = list.filter(
var_is_or_may_contain_solver_type(ModuleInfo, VarTypes0),
set_of_var.to_sorted_list(BodyNonLocals)),
SolverNonLocals = []
then
BodyContext = goal_info_get_context(BodyGoalInfo0),
term.context_init(EmptyContext),
( if BodyContext = EmptyContext then
true
else
mode_info_set_context(BodyContext, !ModeInfo)
),
% Modecheck each clause of the procedure body separately.
(
WhatToCheck = check_modes,
(
ClausesForm0 = clause_disj(Disjuncts1),
flatten_disj(Disjuncts1, Disjuncts2),
list.map_foldl(
modecheck_clause_disj(CheckpointMsg, HeadVars,
InstMap0, ArgFinalInsts0),
Disjuncts2, Disjuncts, !ModeInfo),
NewGoalExpr = disj(Disjuncts)
;
ClausesForm0 = clause_switch(SwitchVar, CanFail, Cases1),
list.map_foldl(
modecheck_clause_switch(CheckpointMsg, HeadVars,
InstMap0, ArgFinalInsts0, SwitchVar),
Cases1, Cases, !ModeInfo),
NewGoalExpr = switch(SwitchVar, CanFail, Cases)
)
;
WhatToCheck = check_unique_modes,
mode_info_get_nondet_live_vars(!.ModeInfo, NondetLiveVars0),
Detism = goal_info_get_determinism(BodyGoalInfo0),
NonLocals = goal_info_get_nonlocals(BodyGoalInfo0),
determinism_components(Detism, _, SolnCount),
(
SolnCount = at_most_many
;
( SolnCount = at_most_zero
; SolnCount = at_most_one
; SolnCount = at_most_many_cc
),
mode_info_set_nondet_live_vars(bag.init, !ModeInfo)
),
(
ClausesForm0 = clause_disj(Disjuncts1),
flatten_disj(Disjuncts1, Disjuncts2),
(
SolnCount = at_most_many,
mode_info_add_live_vars(NonLocals, !ModeInfo),
make_all_nondet_live_vars_mostly_uniq(!ModeInfo),
mode_info_remove_live_vars(NonLocals, !ModeInfo)
;
( SolnCount = at_most_zero
; SolnCount = at_most_one
; SolnCount = at_most_many_cc
)
),
list.map_foldl(
unique_modecheck_clause_disj(CheckpointMsg, HeadVars,
InstMap0, ArgFinalInsts0, Detism, NonLocals,
NondetLiveVars0),
Disjuncts2, Disjuncts, !ModeInfo),
NewGoalExpr = disj(Disjuncts)
;
ClausesForm0 = clause_switch(SwitchVar, CanFail, Cases1),
list.map_foldl(
unique_modecheck_clause_switch(CheckpointMsg, HeadVars,
InstMap0, ArgFinalInsts0, SwitchVar),
Cases1, Cases, !ModeInfo),
NewGoalExpr = switch(SwitchVar, CanFail, Cases)
)
),
% Manufacture an instmap_delta for the disjunction as a whole.
assoc_list.from_corresponding_lists(HeadVars, ArgFinalInsts0,
HeadVarFinalInsts),
FinalInstMap = instmap_from_assoc_list(HeadVarFinalInsts),
compute_instmap_delta(InstMap0, FinalInstMap, BodyNonLocals,
DeltaInstMap),
goal_info_set_instmap_delta(DeltaInstMap, BodyGoalInfo0, BodyGoalInfo),
Body = hlds_goal(NewGoalExpr, BodyGoalInfo),
ArgFinalInsts = ArgFinalInsts0
else
% Modecheck the procedure body as a single goal.
mode_checkpoint(enter, CheckpointMsg, !ModeInfo),
(
WhatToCheck = check_modes,
modecheck_goal(Body0, Body1, !ModeInfo)
;
WhatToCheck = check_unique_modes,
unique_modes_check_goal(Body0, Body1, !ModeInfo)
),
mode_checkpoint(exit, CheckpointMsg, !ModeInfo),
% Check that final insts match those specified in the mode declaration.
(
IsUnifyPred = no,
GroundMatchesBound = ground_matches_bound_if_complete
;
IsUnifyPred = yes,
GroundMatchesBound = ground_matches_bound_always
),
modecheck_final_insts_gmb(HeadVars, InferModes, GroundMatchesBound,
ArgFinalInsts0, ArgFinalInsts, Body1, Body, !ModeInfo)
).
%-----------------------------------------------------------------------------%
% Do mode analysis of the queued procedures. If the first argument is
% `unique_mode_check', then also go on and do full determinism analysis
% and unique mode analysis on them as well. The pred_table arguments
% are used to store copies of the procedure bodies before unique mode
% analysis, so that we can restore them before doing the next analysis
% pass.
%
:- pred modecheck_queued_procs(how_to_check_goal::in,
pred_table::in, pred_table::out, module_info::in, module_info::out,
bool::in, bool::out, list(error_spec)::in, list(error_spec)::out) is det.
modecheck_queued_procs(HowToCheckGoal, !OldPredTable, !ModuleInfo,
!Changed, !Specs) :-
module_info_get_proc_requests(!.ModuleInfo, Requests0),
get_req_queue(Requests0, RequestQueue0),
( if queue.get(PredProcId, RequestQueue0, RequestQueue1) then
set_req_queue(RequestQueue1, Requests0, Requests1),
module_info_set_proc_requests(Requests1, !ModuleInfo),
% Check that the procedure is valid before attempt to do mode analysis
% on it. This check is necessary to avoid internal errors caused by
% (a) doing mode analysis on type-incorrect code, and (b) doing mode
% inference on predicates that have higher order arguments.
PredProcId = proc(PredId, _ProcId),
module_info_get_valid_pred_id_set(!.ModuleInfo, ValidPredIds),
( if set_tree234.member(PredId, ValidPredIds) then
trace [io(!IO)] (
queued_proc_progress_message(!.ModuleInfo, PredProcId,
HowToCheckGoal, !IO)
),
modecheck_queued_proc(HowToCheckGoal, PredProcId,
!OldPredTable, !ModuleInfo, HeadChanged, HeadSpecs),
bool.or(HeadChanged, !Changed),
!:Specs = HeadSpecs ++ !.Specs
else
true
),
modecheck_queued_procs(HowToCheckGoal, !OldPredTable, !ModuleInfo,
!Changed, !Specs)
else
true
).
:- pred queued_proc_progress_message(module_info::in, pred_proc_id::in,
how_to_check_goal::in, io::di, io::uo) is det.
queued_proc_progress_message(ModuleInfo, PredProcId, HowToCheckGoal, !IO) :-
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
(
VeryVerbose = yes,
(
HowToCheckGoal = check_modes,
io.write_string("% Mode-analysing ", !IO)
;
HowToCheckGoal = check_unique_modes,
io.write_string("% Analysing modes, determinism, " ++
"and unique-modes for\n% ", !IO)
),
write_pred_proc_id(ModuleInfo, PredProcId, !IO),
io.write_string("\n", !IO)
;
VeryVerbose = no
).
:- pred modecheck_queued_proc(how_to_check_goal::in, pred_proc_id::in,
pred_table::in, pred_table::out, module_info::in, module_info::out,
bool::out, list(error_spec)::out) is det.
modecheck_queued_proc(HowToCheckGoal, PredProcId, !OldPredTable, !ModuleInfo,
!:Changed, Specs) :-
PredProcId = proc(PredId, ProcId),
module_info_get_preds(!.ModuleInfo, Preds0),
map.lookup(Preds0, PredId, PredInfo0),
pred_info_get_proc_table(PredInfo0, Procs0),
map.lookup(Procs0, ProcId, ProcInfo0),
% Mark the procedure as ready to be processed.
proc_info_set_can_process(can_process_now, ProcInfo0, ProcInfo1),
map.det_update(ProcId, ProcInfo1, Procs0, Procs1),
pred_info_set_proc_table(Procs1, PredInfo0, PredInfo1),
map.det_update(PredId, PredInfo1, Preds0, Preds1),
module_info_set_preds(Preds1, !ModuleInfo),
% Modecheck the procedure.
modecheck_proc(ProcId, PredId, !ModuleInfo, ModeSpecs, !:Changed),
module_info_get_globals(!.ModuleInfo, Globals),
ModeErrors = contains_errors(Globals, ModeSpecs),
(
ModeErrors = yes,
module_info_make_pred_id_invalid(PredId, !ModuleInfo),
Specs = ModeSpecs
;
ModeErrors = no,
(
HowToCheckGoal = check_unique_modes,
module_info_get_preds(!.ModuleInfo, Preds2),
map.lookup(Preds2, PredId, PredInfo2),
pred_info_get_proc_table(PredInfo2, Procs2),
map.lookup(Procs2, ProcId, ProcInfo2),
SwitchDetectInfo = init_switch_detect_info(!.ModuleInfo),
detect_switches_in_proc(SwitchDetectInfo, ProcInfo2, ProcInfo3),
map.det_update(ProcId, ProcInfo3, Procs2, Procs3),
pred_info_set_proc_table(Procs3, PredInfo2, PredInfo3),
map.det_update(PredId, PredInfo3, Preds2, Preds3),
module_info_set_preds(Preds3, !ModuleInfo),
detect_cse_in_proc(PredId, ProcId, !ModuleInfo),
determinism_check_proc(ProcId, PredId, !ModuleInfo, DetismSpecs),
expect(unify(DetismSpecs, []), $pred, "found detism error"),
save_proc_info(ProcId, PredId, !.ModuleInfo, !OldPredTable),
unique_modes_check_proc(ProcId, PredId, !ModuleInfo,
NewChanged, UniqueSpecs),
bool.or(NewChanged, !Changed),
Specs = ModeSpecs ++ UniqueSpecs
;
HowToCheckGoal = check_modes,
Specs = ModeSpecs
)
).
% Save a copy of the proc info for the specified procedure in
% !OldProcTable.
%
:- pred save_proc_info(proc_id::in, pred_id::in, module_info::in,
pred_table::in, pred_table::out) is det.
save_proc_info(ProcId, PredId, ModuleInfo, !OldPredTable) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
_PredInfo, ProcInfo),
map.lookup(!.OldPredTable, PredId, OldPredInfo0),
pred_info_get_proc_table(OldPredInfo0, OldProcTable0),
map.set(ProcId, ProcInfo, OldProcTable0, OldProcTable),
pred_info_set_proc_table(OldProcTable, OldPredInfo0, OldPredInfo),
map.det_update(PredId, OldPredInfo, !OldPredTable).
%-----------------------------------------------------------------------------%
:- type clause_form
---> clause_disj(list(hlds_goal))
; clause_switch(prog_var, can_fail, list(case)).
:- pred modecheck_clause_disj(string::in, list(prog_var)::in, instmap::in,
list(mer_inst)::in, hlds_goal::in, hlds_goal::out,
mode_info::in, mode_info::out) is det.
modecheck_clause_disj(CheckpointMsg, HeadVars, InstMap0, ArgFinalInsts0,
Disjunct0, Disjunct, !ModeInfo) :-
mode_checkpoint(enter, CheckpointMsg, !ModeInfo),
mode_info_set_instmap(InstMap0, !ModeInfo),
modecheck_goal(Disjunct0, Disjunct1, !ModeInfo),
mode_checkpoint(exit, CheckpointMsg, !ModeInfo),
% Check that final insts match those specified in the mode declaration.
modecheck_final_insts(HeadVars, no, ArgFinalInsts0, _ArgFinalInsts,
Disjunct1, Disjunct, !ModeInfo).
:- pred modecheck_clause_switch(string::in, list(prog_var)::in, instmap::in,
list(mer_inst)::in, prog_var::in, case::in, case::out,
mode_info::in, mode_info::out) is det.
modecheck_clause_switch(CheckpointMsg, HeadVars, InstMap0, ArgFinalInsts0,
Var, Case0, Case, !ModeInfo) :-
mode_checkpoint(enter, CheckpointMsg, !ModeInfo),
Case0 = case(MainConsId, OtherConsIds, Goal0),
mode_info_set_instmap(InstMap0, !ModeInfo),
modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
% Modecheck this case (if it is reachable).
mode_info_get_instmap(!.ModeInfo, InstMap1),
( if instmap_is_reachable(InstMap1) then
modecheck_goal(Goal0, Goal1, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, InstMap)
else
% We should not mode-analyse the goal, since it is unreachable.
% Instead we optimize the goal away, so that later passes
% won't complain about it not having mode information.
Goal1 = true_goal,
InstMap = InstMap1
),
% Don't lose the information added by the functor test above.
fixup_instmap_switch_var(Var, InstMap0, InstMap, Goal1, Goal2),
mode_checkpoint(exit, CheckpointMsg, !ModeInfo),
% Check that final insts match those specified in the mode declaration.
modecheck_final_insts(HeadVars, no, ArgFinalInsts0,
_ArgFinalInsts, Goal2, Goal, !ModeInfo),
Case = case(MainConsId, OtherConsIds, Goal).
:- pred unique_modecheck_clause_disj(string::in, list(prog_var)::in,
instmap::in, list(mer_inst)::in, determinism::in, set_of_progvar::in,
bag(prog_var)::in, hlds_goal::in, hlds_goal::out,
mode_info::in, mode_info::out) is det.
unique_modecheck_clause_disj(CheckpointMsg, HeadVars, InstMap0, ArgFinalInsts0,
DisjDetism, DisjNonLocals, NondetLiveVars0,
Disjunct0, Disjunct, !ModeInfo) :-
mode_checkpoint(enter, CheckpointMsg, !ModeInfo),
mode_info_set_instmap(InstMap0, !ModeInfo),
mode_info_set_nondet_live_vars(NondetLiveVars0, !ModeInfo),
unique_modes.prepare_for_disjunct(Disjunct0, DisjDetism, DisjNonLocals,
!ModeInfo),
unique_modes_check_goal(Disjunct0, Disjunct1, !ModeInfo),
mode_checkpoint(exit, CheckpointMsg, !ModeInfo),
% Check that final insts match those specified in the mode declaration.
modecheck_final_insts(HeadVars, no, ArgFinalInsts0,
_ArgFinalInsts, Disjunct1, Disjunct, !ModeInfo).
:- pred unique_modecheck_clause_switch(string::in, list(prog_var)::in,
instmap::in, list(mer_inst)::in, prog_var::in, case::in, case::out,
mode_info::in, mode_info::out) is det.
unique_modecheck_clause_switch(CheckpointMsg, HeadVars, InstMap0,
ArgFinalInsts0, Var, Case0, Case, !ModeInfo) :-
mode_checkpoint(enter, CheckpointMsg, !ModeInfo),
Case0 = case(MainConsId, OtherConsIds, Goal0),
mode_info_set_instmap(InstMap0, !ModeInfo),
modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, InstMap1),
( if instmap_is_reachable(InstMap1) then
unique_modes_check_goal(Goal0, Goal1, !ModeInfo)
else
% We should not mode-analyse the goal, since it is unreachable.
% Instead we optimize the goal away, so that later passes
% won't complain about it not having mode information.
Goal1 = true_goal
),
% Don't lose the information added by the functor test above.
mode_info_get_instmap(!.ModeInfo, InstMap),
fixup_instmap_switch_var(Var, InstMap0, InstMap, Goal1, Goal2),
mode_checkpoint(exit, CheckpointMsg, !ModeInfo),
% Check that final insts match those specified in the mode declaration.
modecheck_final_insts(HeadVars, no, ArgFinalInsts0, _ArgFinalInsts,
Goal2, Goal, !ModeInfo),
Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
modecheck_lambda_final_insts(HeadVars, ArgFinalInsts, !Goal, !ModeInfo) :-
% This is modecheck_final_insts for a lambda expression.
%
% For lambda expressions, modes must always be declared;
% we never infer them.
InferModes = no,
modecheck_final_insts(HeadVars, InferModes, ArgFinalInsts,
_NewFinalInsts, !Goal, !ModeInfo).
% Check that the final insts of the head vars match their expected insts.
%
:- pred modecheck_final_insts(list(prog_var)::in, bool::in,
list(mer_inst)::in, list(mer_inst)::out, hlds_goal::in, hlds_goal::out,
mode_info::in, mode_info::out) is det.
modecheck_final_insts(HeadVars, InferModes, !FinalInsts, !Body, !ModeInfo) :-
modecheck_final_insts_gmb(HeadVars, InferModes,
ground_matches_bound_if_complete, !FinalInsts, !Body, !ModeInfo).
:- pred modecheck_final_insts_gmb(list(prog_var)::in, bool::in,
ground_matches_bound::in, list(mer_inst)::in, list(mer_inst)::out,
hlds_goal::in, hlds_goal::out, mode_info::in, mode_info::out) is det.
modecheck_final_insts_gmb(HeadVars, InferModes, GroundMatchesBound,
FinalInsts0, FinalInsts, Body0, Body, !ModeInfo) :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
mode_info_get_errors(!.ModeInfo, Errors),
% If there were any mode errors, use an unreachable instmap.
% This ensures that we don't get unwanted flow-on errors.
% This is not strictly necessary, since we only report the
% first mode error anyway, and the resulting FinalInsts
% will not be used; but it improves the readability of the
% rejected modes.
(
Errors = [_ | _],
% If there were any mode errors, something must have changed, since
% if the procedure had mode errors in a previous pass, then it
% wouldn't have been processed at all in this pass.
Changed0 = yes,
instmap.init_unreachable(InstMap)
;
Errors = [],
Changed0 = no,
mode_info_get_instmap(!.ModeInfo, InstMap)
),
mode_info_get_var_types(!.ModeInfo, VarTypes),
instmap_lookup_vars(InstMap, HeadVars, VarFinalInsts1),
lookup_var_types(VarTypes, HeadVars, ArgTypes),
(
InferModes = yes,
normalise_insts(ModuleInfo, ArgTypes, VarFinalInsts1, VarFinalInsts2),
% Make sure we set the final insts of any variables which
% we assumed were dead to `clobbered'.
mode_info_get_pred_id(!.ModeInfo, PredId),
mode_info_get_proc_id(!.ModeInfo, ProcId),
module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
proc_info_arglives(ProcInfo, ModuleInfo, ArgLives),
maybe_clobber_insts(VarFinalInsts2, ArgLives, FinalInsts),
check_final_insts(HeadVars, FinalInsts0, FinalInsts, InferModes,
GroundMatchesBound, 1, ModuleInfo, Body0, Body, no, Changed1,
!ModeInfo),
mode_info_get_changed_flag(!.ModeInfo, Changed2),
bool.or_list([Changed0, Changed1, Changed2], Changed),
mode_info_set_changed_flag(Changed, !ModeInfo)
;
InferModes = no,
check_final_insts(HeadVars, FinalInsts0, VarFinalInsts1, InferModes,
GroundMatchesBound, 1, ModuleInfo, Body0, Body, no, _Changed1,
!ModeInfo),
FinalInsts = FinalInsts0
).
:- pred maybe_clobber_insts(list(mer_inst)::in, list(is_live)::in,
list(mer_inst)::out) is det.
maybe_clobber_insts([], [], []).
maybe_clobber_insts([], [_ | _], _) :-
unexpected($pred, "length mismatch").
maybe_clobber_insts([_ | _], [], _) :-
unexpected($pred, "length mismatch").
maybe_clobber_insts([Inst0 | Insts0], [IsLive | IsLives], [Inst | Insts]) :-
(
IsLive = is_dead,
Inst = ground(clobbered, none_or_default_func)
;
IsLive = is_live,
Inst = Inst0
),
maybe_clobber_insts(Insts0, IsLives, Insts).
:- pred check_final_insts(list(prog_var)::in,
list(mer_inst)::in, list(mer_inst)::in, bool::in, ground_matches_bound::in,
int::in, module_info::in, hlds_goal::in, hlds_goal::out,
bool::in, bool::out, mode_info::in, mode_info::out) is det.
check_final_insts(Vars, Insts, VarInsts, InferModes, GroundMatchesBound,
ArgNum, ModuleInfo, !Goal, !Changed, !ModeInfo) :-
( if
Vars = [],
Insts = [],
VarInsts = []
then
true
else if
Vars = [Var | VarsTail],
Insts = [Inst | InstsTail],
VarInsts = [VarInst | VarInstsTail]
then
mode_info_get_var_types(!.ModeInfo, VarTypes),
lookup_var_type(VarTypes, Var, Type),
( if
inst_matches_final_gmb(VarInst, Inst, Type, ModuleInfo,
GroundMatchesBound)
then
true
else
!:Changed = yes,
(
% If we are inferring the mode, then don't report an error,
% just set changed to yes to make sure that we will do
% another fixpoint pass.
InferModes = yes
;
InferModes = no,
% XXX This might need to be reconsidered now we have
% unique modes.
( if
inst_matches_initial(VarInst, Inst, Type, ModuleInfo)
then
Reason = too_instantiated
else if
% The only reason why VarInst is not good enough
% if the expected Inst is simply `ground' is that
% it is not instantiated enough. Unfortunately,
% we need to test separately for this, because the call
% to inst_matches_initial below can fail, even if
% Inst is `ground', because VarInst contains parts
% that are too unique, or because it does not cover
% all the function symbols in Type.
% This is a side effect of having an inst representation
% that entangles uniqueness information and which-functor
% information with information about how bound a variable
% is. In the extremely common case that Inst is `ground',
% we need only the latter, but we can't get it by itself.
( Inst = ground(shared, none_or_default_func)
; inst_matches_initial(Inst, VarInst, Type, ModuleInfo)
)
then
Reason = not_instantiated_enough
else
% I don't think this can happen. But just in case...
Reason = wrongly_instantiated
),
set_of_var.init(WaitingVars),
ModeError = mode_error_final_inst(ArgNum, Var, VarInst,
Inst, Reason),
mode_info_error(WaitingVars, ModeError, !ModeInfo)
)
),
check_final_insts(VarsTail, InstsTail, VarInstsTail,
InferModes, GroundMatchesBound, ArgNum + 1, ModuleInfo,
!Goal, !Changed, !ModeInfo)
else
unexpected($pred, "length mismatch")
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Check that the evaluation method is OK for the given mode(s).
% We also check the mode of main/2 here.
%
:- pred check_eval_methods(module_info::in,
list(error_spec)::in, list(error_spec)::out) is det.
check_eval_methods(ModuleInfo, !Specs) :-
module_info_get_valid_pred_ids(ModuleInfo, PredIds),
pred_check_eval_methods(ModuleInfo, PredIds, !Specs).
:- pred pred_check_eval_methods(module_info::in, list(pred_id)::in,
list(error_spec)::in, list(error_spec)::out) is det.
pred_check_eval_methods(_, [], !Specs).
pred_check_eval_methods(ModuleInfo, [PredId | PredIds], !Specs) :-
module_info_get_preds(ModuleInfo, Preds),
map.lookup(Preds, PredId, PredInfo),
ProcIds = pred_info_procids(PredInfo),
proc_check_eval_methods(ModuleInfo, PredId, ProcIds, !Specs),
pred_check_eval_methods(ModuleInfo, PredIds, !Specs).
:- pred proc_check_eval_methods(module_info::in, pred_id::in,
list(proc_id)::in, list(error_spec)::in, list(error_spec)::out) is det.
proc_check_eval_methods(_, _, [], !Specs).
proc_check_eval_methods(ModuleInfo, PredId, [ProcId | ProcIds], !Specs) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
proc_info_get_eval_method(ProcInfo, EvalMethod),
proc_info_get_argmodes(ProcInfo, Modes),
( if
eval_method_requires_ground_args(EvalMethod) = yes,
not only_fully_in_out_modes(Modes, ModuleInfo)
then
GroundArgsSpec = report_eval_method_requires_ground_args(ProcInfo),
!:Specs = [GroundArgsSpec | !.Specs]
else
true
),
( if
eval_method_destroys_uniqueness(EvalMethod) = yes,
not only_nonunique_modes(Modes, ModuleInfo)
then
UniquenessSpec = report_eval_method_destroys_uniqueness(ProcInfo),
!:Specs = [UniquenessSpec | !.Specs]
else
true
),
( if
pred_info_name(PredInfo) = "main",
pred_info_orig_arity(PredInfo) = 2,
pred_info_is_exported(PredInfo),
not check_mode_of_main(Modes, ModuleInfo)
then
MainSpec = report_wrong_mode_for_main(ProcInfo),
!:Specs = [MainSpec | !.Specs]
else
true
),
proc_check_eval_methods(ModuleInfo, PredId, ProcIds, !Specs).
:- pred only_fully_in_out_modes(list(mer_mode)::in, module_info::in)
is semidet.
only_fully_in_out_modes([], _).
only_fully_in_out_modes([Mode | Rest], ModuleInfo) :-
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
(
inst_is_ground(ModuleInfo, InitialInst)
;
inst_is_free(ModuleInfo, InitialInst),
(
inst_is_free(ModuleInfo, FinalInst)
;
inst_is_ground(ModuleInfo, FinalInst)
)
),
only_fully_in_out_modes(Rest, ModuleInfo).
:- pred only_nonunique_modes(list(mer_mode)::in, module_info::in) is semidet.
only_nonunique_modes([], _).
only_nonunique_modes([Mode | Rest], ModuleInfo) :-
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
inst_is_not_partly_unique(ModuleInfo, InitialInst),
inst_is_not_partly_unique(ModuleInfo, FinalInst),
only_nonunique_modes(Rest, ModuleInfo).
:- pred check_mode_of_main(list(mer_mode)::in, module_info::in) is semidet.
check_mode_of_main([Di, Uo], ModuleInfo) :-
mode_get_insts(ModuleInfo, Di, DiInitialInst, DiFinalInst),
mode_get_insts(ModuleInfo, Uo, UoInitialInst, UoFinalInst),
%
% Note that we hard-code these tests,
% rather than using `inst_is_free', `inst_is_unique', etc.,
% since for main/2 we're looking for an exact match
% (modulo inst synonyms) with what the language reference
% manual specifies, rather than looking for a particular
% abstract property.
%
Unique = ground(unique, none_or_default_func),
Clobbered = ground(clobbered, none_or_default_func),
inst_expand(ModuleInfo, DiInitialInst, Unique),
inst_expand(ModuleInfo, DiFinalInst, Clobbered),
inst_expand(ModuleInfo, UoInitialInst, Free),
( Free = free ; Free = free(_Type) ),
inst_expand(ModuleInfo, UoFinalInst, Unique).
:- func report_eval_method_requires_ground_args(proc_info) = error_spec.
report_eval_method_requires_ground_args(ProcInfo) = Spec :-
proc_info_get_eval_method(ProcInfo, EvalMethod),
proc_info_get_context(ProcInfo, Context),
EvalMethodS = eval_method_to_string(EvalMethod),
MainPieces = [words("Sorry, not implemented:"),
pragma_decl(EvalMethodS),
words("declaration not allowed for procedure"),
words("with partially instantiated modes."), nl],
VerbosePieces = [words("Tabling of predicates/functions"),
words("with partially instantiated modes"),
words("is not currently implemented."), nl],
Msg = simple_msg(Context,
[always(MainPieces), verbose_only(verbose_once, VerbosePieces)]),
Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
[Msg]).
:- func report_eval_method_destroys_uniqueness(proc_info) = error_spec.
report_eval_method_destroys_uniqueness(ProcInfo) = Spec :-
proc_info_get_eval_method(ProcInfo, EvalMethod),
proc_info_get_context(ProcInfo, Context),
EvalMethodS = eval_method_to_string(EvalMethod),
MainPieces = [words("Error:"),
pragma_decl(EvalMethodS),
words("declaration not allowed for procedure"),
words("with unique modes."), nl],
VerbosePieces =
[words("Tabling of predicates/functions with unique modes"),
words("is not allowed as this would lead to a copying"),
words("of the unique arguments which would result"),
words("in them no longer being unique."), nl],
Msg = simple_msg(Context,
[always(MainPieces), verbose_only(verbose_once, VerbosePieces)]),
Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
[Msg]).
:- func report_wrong_mode_for_main(proc_info) = error_spec.
report_wrong_mode_for_main(ProcInfo) = Spec :-
proc_info_get_context(ProcInfo, Context),
Pieces = [words("Error:"),
unqual_sym_name_and_arity(sym_name_arity(unqualified("main"), 2)),
words("must have mode"), quote("(di, uo)"), suffix("."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
[Msg]).
%-----------------------------------------------------------------------------%
:- end_module check_hlds.modes.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink