mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-17 18:33:58 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/compiler/termination.m
Zoltan Somogyi 307b1dc148 Split up error_util.m into five modules. 
compiler/error_spec.m:
    This new module contains the part of the old error_util.m that defines
    the error_spec type, and some functions that can help construct pieces
    of error_specs. Most modules of the compiler that deal with errors
    will need to import only this part of the old error_util.m.

    This change also renames the format_component type to format_piece,
    which matches our long-standing naming convention for variables containing
    (lists of) values of this type.

compiler/write_error_spec.m:
    This new module contains the part of the old error_util.m that
    writes out error specs, and converts them to strings.

    This diff marks as obsolete the versions of predicates that
    write out error specs to the current output stream, without
    *explicitly* specifying the intended stream.

compiler/error_sort.m:
    This new module contains the part of the old error_util.m that
    sorts lists of error specs and error msgs.

compiler/error_type_util.m:
    This new module contains the part of the old error_util.m that
    convert types to format_pieces that generate readable output.

compiler/parse_tree.m:
compiler/notes/compiler_design.html:
    Include and document the new modules.

compiler/error_util.m:
    The code remaining in the original error_util.m consists of
    general utility predicates and functions that don't fit into
    any of the modules above.

    Delete an unneeded pair of I/O states from the argument list
    of a predicate.

compiler/file_util.m:
    Move the unable_to_open_file predicate here from error_util.m,
    since it belongs here. Mark another predicate that writes
    to the current output stream as obsolete.

compiler/hlds_error_util.m:
    Mark two predicates that wrote out error_spec to the current output
    stream as obsolete, and add versions that take an explicit output stream.

compiler/Mercury.options:
    Compile the modules that call the newly obsoleted predicates
    with --no-warn-obsolete, for the time being.

compiler/*.m:
    Conform to the changes above, mostly by updating import_module
    declarations, and renaming format_component to format_piece.
2022-10-12 20:50:16 +11:00

855 lines
35 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2001, 2003-2011 The University of Melbourne.
% Copyright (C) 2017 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: termination.m.
% Main author: crs.
% Significant modifications by zs.
%
% This termination analysis is based on the algorithm given by Gerhard Groeger
% and Lutz Plumer in their paper "Handling of Mutual Recursion in Automatic
% Termination Proofs for Logic Programs" which was printed in JICSLP '92 (the
% proceedings of the Joint International Conference and Symposium on Logic
% Programming 1992) pages 336 - 350.
%
% Details about this implementation are covered in:
% Chris Speirs, Zoltan Somogyi, and Harald Sondergaard. Termination
% analysis for Mercury. In P. Van Hentenryck, editor, Static Analysis:
% Proceedings of the 4th International Symposium, Lecture Notes in Computer
% Science. Springer, 1997. A more detailed version is available for
% download from the papers page of mercurylang.org.
%
% The termination analysis may use a number of different norms to calculate
% the size of a term. These are set by using the --termination-norm string
% option.
%
%-----------------------------------------------------------------------------%
:- module transform_hlds.termination.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module parse_tree.
:- import_module parse_tree.error_spec.
:- import_module list.
%-----------------------------------------------------------------------------%
% Perform termination analysis on the module.
%
:- pred analyse_termination_in_module(module_info::in, module_info::out,
list(error_spec)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds.hlds_dependency_graph.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.pred_name.
:- import_module hlds.status.
:- import_module libs.
:- import_module libs.dependency_graph.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_data_pragma.
:- import_module transform_hlds.post_term_analysis.
:- import_module transform_hlds.term_errors.
:- import_module transform_hlds.term_norm.
:- import_module transform_hlds.term_pass1.
:- import_module transform_hlds.term_pass2.
:- import_module transform_hlds.term_util.
:- import_module bool.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module term.
:- import_module unit.
%-----------------------------------------------------------------------------%
analyse_termination_in_module(!ModuleInfo, !:Specs) :-
module_info_get_globals(!.ModuleInfo, Globals),
globals.get_termination_norm(Globals, TermNorm),
FunctorInfo = set_functor_info(!.ModuleInfo, TermNorm),
globals.lookup_int_option(Globals, termination_error_limit, MaxErrors),
globals.lookup_int_option(Globals, termination_path_limit, MaxPaths),
PassInfo = pass_info(FunctorInfo, MaxErrors, MaxPaths),
% Process builtin and compiler-generated predicates, and user-supplied
% pragmas.
should_we_believe_check_termination_markers(!.ModuleInfo,
BelieveCheckTerm),
module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
term_preprocess_preds(BelieveCheckTerm, PredIds, !ModuleInfo),
% Process all the SCCs of the call graph in a bottom-up order.
module_info_ensure_dependency_info(!ModuleInfo, DepInfo),
SCCs = dependency_info_get_bottom_up_sccs(DepInfo),
% Set the termination status of foreign_procs based on the foreign code
% attributes.
!:Specs = [],
check_foreign_code_attributes(SCCs, !ModuleInfo, !Specs),
% Ensure that termination pragmas for a procedure do not conflict with
% termination pragmas for other procedures in the SCC.
check_pragmas_are_consistent(SCCs, !ModuleInfo, !Specs),
list.foldl2(analyse_termination_in_scc(PassInfo), SCCs,
!ModuleInfo, !Specs),
run_post_term_analysis(!.ModuleInfo, PostSpecs),
!:Specs = PostSpecs ++ !.Specs,
module_info_get_proc_analysis_kinds(!.ModuleInfo, ProcAnalysisKinds0),
set.insert(pak_termination, ProcAnalysisKinds0, ProcAnalysisKinds),
module_info_set_proc_analysis_kinds(ProcAnalysisKinds, !ModuleInfo).
%----------------------------------------------------------------------------%
%
% Handle foreign code attributes.
%
% Set the termination status for any procedures implemented using the foreign
% language interface. If the terminates/does_not_terminate attribute has been
% set then we set the termination status of the procedure accordingly.
% Otherwise the procedure is considered to be terminating if it does not call
% Mercury and non-terminating if it does.
%
% We also check that the foreign code attributes do not conflict with any
% termination pragmas that have been supplied for the procedure.
:- pred check_foreign_code_attributes(list(scc)::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_foreign_code_attributes(SCCs, !ModuleInfo, !Specs) :-
list.foldl2(check_foreign_code_attributes_in_scc, SCCs,
!ModuleInfo, !Specs).
:- pred check_foreign_code_attributes_in_scc(scc::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_foreign_code_attributes_in_scc(SCC, !ModuleInfo, !Specs) :-
set.to_sorted_list(SCC, PPIds),
(
PPIds = [],
unexpected($pred, "empty SCC")
;
PPIds = [PPId],
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
( if
proc_info_get_goal(ProcInfo0, Goal),
Goal = hlds_goal(GoalExpr, _GoalInfo),
GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _)
then
check_foreign_code_attributes_of_proc(!.ModuleInfo, PPId,
Attributes, ProcInfo0, ProcInfo, !Specs),
module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo,
!ModuleInfo)
else
true
)
;
PPIds = [_, _ | _]
% Foreign code proc cannot be mutually recursive.
).
:- pred check_foreign_code_attributes_of_proc(module_info::in,
pred_proc_id::in, pragma_foreign_proc_attributes::in,
proc_info::in, proc_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_foreign_code_attributes_of_proc(ModuleInfo, PPId, Attributes,
!ProcInfo, !Specs) :-
proc_info_get_maybe_termination_info(!.ProcInfo, MaybeTermination),
proc_info_get_context(!.ProcInfo, Context),
(
MaybeTermination = no,
( if attributes_imply_termination(Attributes) then
TermStatus = yes(cannot_loop(unit)),
proc_info_set_maybe_termination_info(TermStatus, !ProcInfo)
else
TermErr = term_error(Context, does_not_term_foreign(PPId)),
TermStatus = yes(can_loop([TermErr])),
proc_info_set_maybe_termination_info(TermStatus, !ProcInfo)
)
;
% If there was a `:- pragma terminates' declaration for this procedure,
% then check that the foreign code attributes do not contradict this.
MaybeTermination = yes(cannot_loop(_)),
ProcTerminates = get_terminates(Attributes),
(
ProcTerminates = proc_does_not_terminate,
TermErr = term_error(Context, inconsistent_annotations),
TermStatus = yes(can_loop([TermErr])),
% XXX intermod
proc_info_set_maybe_termination_info(TermStatus, !ProcInfo),
ProcNamePieces = describe_one_proc_name(ModuleInfo,
should_module_qualify, PPId),
Pieces = [words("Warning:") | ProcNamePieces] ++ [words("has a"),
pragma_decl("terminates"), words("declaration"),
words("but also has the"), quote("does_not_terminate"),
words("foreign code attribute set.")],
Spec = simplest_spec($pred, severity_warning, phase_read_files,
Context, Pieces),
!:Specs = [Spec | !.Specs]
;
( ProcTerminates = proc_terminates
; ProcTerminates = depends_on_mercury_calls
)
)
;
% If there was a `:- pragma does_not_terminate' declaration
% for this procedure, then check that the foreign code attributes
% do not contradict this.
MaybeTermination = yes(can_loop(TermErrs0)),
ProcTerminates = get_terminates(Attributes),
(
ProcTerminates = proc_terminates,
TermErr = term_error(Context, inconsistent_annotations),
TermErrs = [TermErr | TermErrs0],
TermStatus = yes(can_loop(TermErrs)),
% XXX intermod
proc_info_set_maybe_termination_info(TermStatus, !ProcInfo),
ProcNamePieces = describe_one_proc_name(ModuleInfo,
should_module_qualify, PPId),
Pieces = [words("Warning:") | ProcNamePieces] ++ [words("has a"),
pragma_decl("does_not_terminate"), words("declaration"),
words("but also has the"), quote("terminates"),
words("foreign code attribute set.")],
Spec = simplest_spec($pred, severity_warning, phase_read_files,
Context, Pieces),
!:Specs = [Spec | !.Specs]
;
( ProcTerminates = proc_does_not_terminate
; ProcTerminates = depends_on_mercury_calls
)
)
).
%----------------------------------------------------------------------------%
%
% Check termination pragmas for consistency.
%
% Check that any user-supplied termination information (from pragma
% terminates/does_not_terminate) is consistent for each SCC in the program.
%
% The information will not be consistent if:
% (1) One or more procs. in the SCC has a terminates pragma *and* one or more
% procs. in the SCC has a does_not_terminate pragma.
% (2) One or more procs. in the SCC has a termination pragma (of either sort),
% *and* the termination status of one or more procs. in the SCC is
% unknown. (We check this after checking for the first case, so the
% termination info. for the known procs. will be consistent.)
%
% In the first case set the termination for all procs. in the SCC to can_loop
% and emit a warning. In the second, set the termination of any procedures
% whose termination status is unknown to be the same as those whose
% termination status is known.
:- pred check_pragmas_are_consistent(list(scc)::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_pragmas_are_consistent(SCCs, !ModuleInfo, !Specs) :-
list.foldl2(check_scc_pragmas_are_consistent, SCCs, !ModuleInfo, !Specs).
:- pred check_scc_pragmas_are_consistent(scc::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_scc_pragmas_are_consistent(SCC, !ModuleInfo, !Specs) :-
classify_termination_status(!.ModuleInfo, set.to_sorted_list(SCC),
set.init, KnownPredNamesIdsSet, set.init, KnownContextSet,
set.init, KnownTermStatusSet, set.init, UnknownPPIdSet),
KnownTermStatuses = set.to_sorted_list(KnownTermStatusSet),
(
KnownTermStatuses = []
% We don't know the termination status of any procedure in the SCC.
;
KnownTermStatuses = [KnownTermStatus],
% We know the termination status of at least one procedure in the SCC,
% and all the procedures that do have known termination statuses
% have the same termination status.
set.foldl(set_termination_info(KnownTermStatus),
UnknownPPIdSet, !ModuleInfo)
;
KnownTermStatuses = [_, _ | _],
% We know the termination status of at least two procedures
% in the SCC, and those procedures have two *different*
% termination statuses.
% Emit a warning, and then assume that they all loop.
LeastContext = list.det_head(set.to_sorted_list(KnownContextSet)),
NewTermStatus =
can_loop([term_error(LeastContext, inconsistent_annotations)]),
set.foldl(set_termination_info(NewTermStatus), SCC, !ModuleInfo),
PredNamesIds = set.to_sorted_list(KnownPredNamesIdsSet),
PredNamePieces = describe_several_pred_names(!.ModuleInfo,
should_module_qualify, list.map(pair.snd, PredNamesIds)),
Pieces =
[words("Warning:") | PredNamePieces ] ++
[words("are mutually recursive but some of their"),
words( "termination pragmas are inconsistent.")],
Spec = simplest_spec($pred, severity_warning, phase_read_files,
LeastContext, Pieces),
!:Specs = [Spec | !.Specs]
).
:- pred classify_termination_status(module_info::in, list(pred_proc_id)::in,
set(pair(string, pred_id))::in, set(pair(string, pred_id))::out,
set(prog_context)::in, set(prog_context)::out,
set(termination_info)::in, set(termination_info)::out,
set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
classify_termination_status(_, [],
!KnownPredNamesIds, !KnownContexts,
!KnownTermStatuses, !UnknownPPIds).
classify_termination_status(ModuleInfo, [PPId | PPIds],
!KnownPredNamesIds, !KnownContexts,
!KnownTermStatuses, !UnknownPPIds) :-
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
proc_info_get_maybe_termination_info(ProcInfo, MaybeTermStatus),
(
MaybeTermStatus = yes(TermStatus),
PredName = pred_info_name(PredInfo),
PPId = proc(PredId, _ProcId),
set.insert(PredName - PredId, !KnownPredNamesIds),
% XXX We should be getting the context from the *Proc*Info.
pred_info_get_context(PredInfo, Context),
set.insert(Context, !KnownContexts),
set.insert(TermStatus, !KnownTermStatuses)
;
MaybeTermStatus = no,
set.insert(PPId, !UnknownPPIds)
),
classify_termination_status(ModuleInfo, PPIds,
!KnownPredNamesIds, !KnownContexts,
!KnownTermStatuses, !UnknownPPIds).
%-----------------------------------------------------------------------------%
%
% Run termination analysis on a single SCC.
%
% For each SCC, we first find out the relationships among the sizes of the
% arguments of the procedures of the SCC, and then attempt to prove
% termination of the procedures.
%
:- pred analyse_termination_in_scc(pass_info::in, scc::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
analyse_termination_in_scc(PassInfo, SCC, !ModuleInfo, !Specs) :-
IsArgSizeKnown =
( pred(PPId::in) is semidet :-
module_info_pred_proc_info(!.ModuleInfo, PPId, _, ProcInfo),
proc_info_get_maybe_arg_size_info(ProcInfo, yes(_))
),
set.filter(IsArgSizeKnown, SCC, _SCCArgSizeKnown, SCCArgSizeUnknown),
( if set.is_empty(SCCArgSizeUnknown) then
ArgSizeErrors = [],
TermErrors = []
else
find_arg_sizes_in_scc(!.ModuleInfo, PassInfo, SCCArgSizeUnknown,
ArgSizeResult, TermErrors),
(
ArgSizeResult = arg_size_ok(Solutions, OutputSupplierMap),
set_finite_arg_size_infos(Solutions, OutputSupplierMap,
!ModuleInfo),
ArgSizeErrors = []
;
ArgSizeResult = arg_size_error(Errors),
set.foldl(set_infinite_arg_size_info(infinite(Errors)),
SCCArgSizeUnknown, !ModuleInfo),
ArgSizeErrors = Errors
)
),
set.filter(is_termination_known(!.ModuleInfo), SCC,
_SCCTerminationKnown, SCCTerminationUnknown),
( if set.is_empty(SCCTerminationUnknown) then
% We may possibly have encountered inconsistent
% terminates/does_not_terminate pragmas for this SCC, so we need to
% report errors here as well.
% XXX That comment does not make sense here.
true
else
IsFatal =
( pred(Error::in) is semidet :-
Error = term_error(_Context, ErrorKind),
term_error_kind_is_fatal_error(ErrorKind) = yes
),
list.filter(IsFatal, ArgSizeErrors, FatalErrors),
BothErrors = TermErrors ++ FatalErrors,
(
BothErrors = [_ | _],
% These errors prevent pass 2 from proving termination
% in any case, so we may as well not prove it quickly.
PassInfo = pass_info(_, MaxErrors, _),
list.take_upto(MaxErrors, BothErrors, ReportedErrors),
TerminationResult = can_loop(ReportedErrors)
;
BothErrors = [],
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_int_option(Globals, termination_single_args,
SingleArgs),
prove_termination_in_scc(!.ModuleInfo, PassInfo,
SCCTerminationUnknown, SingleArgs, TerminationResult)
),
set.foldl(set_termination_info(TerminationResult),
SCCTerminationUnknown, !ModuleInfo),
(
TerminationResult = can_loop(TerminationErrors),
maybe_report_termination_errors(!.ModuleInfo, SCC,
TerminationErrors, !Specs)
;
TerminationResult = cannot_loop(_)
)
).
%-----------------------------------------------------------------------------%
% This predicate takes the results from solve_equations and inserts these
% results into the module info.
%
:- pred set_finite_arg_size_infos(list(pair(pred_proc_id, int))::in,
used_args::in, module_info::in, module_info::out) is det.
set_finite_arg_size_infos([], _, !ModuleInfo).
set_finite_arg_size_infos([Soln | Solns], OutputSupplierMap, !ModuleInfo) :-
Soln = PPId - Gamma,
PPId = proc(PredId, ProcId),
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
PredInfo0, ProcInfo0),
map.lookup(OutputSupplierMap, PPId, OutputSuppliers),
ArgSizeInfo = finite(Gamma, OutputSuppliers),
% XXX intermod
proc_info_set_maybe_arg_size_info(yes(ArgSizeInfo), ProcInfo0, ProcInfo),
pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
set_finite_arg_size_infos(Solns, OutputSupplierMap, !ModuleInfo).
:- pred set_infinite_arg_size_info(arg_size_info::in, pred_proc_id::in,
module_info::in, module_info::out) is det.
set_infinite_arg_size_info(ArgSizeInfo, PPId, !ModuleInfo) :-
PPId = proc(PredId, ProcId),
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
PredInfo0, ProcInfo0),
% XXX intermod
proc_info_set_maybe_arg_size_info(yes(ArgSizeInfo), ProcInfo0, ProcInfo),
pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
%-----------------------------------------------------------------------------%
:- pred set_termination_info(termination_info::in, pred_proc_id::in,
module_info::in, module_info::out) is det.
set_termination_info(TerminationInfo, PPId, !ModuleInfo) :-
PPId = proc(PredId, ProcId),
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
PredInfo0, ProcInfo0),
% XXX intermod
proc_info_set_maybe_termination_info(yes(TerminationInfo),
ProcInfo0, ProcInfo),
pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
%-----------------------------------------------------------------------------%
:- pred maybe_report_termination_errors(module_info::in, scc::in,
list(term_error)::in,
list(error_spec)::in, list(error_spec)::out) is det.
maybe_report_termination_errors(ModuleInfo, SCC, Errors, !Specs) :-
decide_what_term_errors_to_report(ModuleInfo, SCC, Errors,
MaybeErrorsToReport),
(
MaybeErrorsToReport = no
;
MaybeErrorsToReport = yes(ErrorsToReport),
report_term_errors(ModuleInfo, SCC, ErrorsToReport, !Specs)
).
:- pred decide_what_term_errors_to_report(module_info::in, scc::in,
list(term_error)::in, maybe(list(term_error))::out) is det.
decide_what_term_errors_to_report(ModuleInfo, SCC, Errors,
MaybeErrorsToReport) :-
% NOTE The code of this predicate follows the same logic as the
% code of decide_what_term2_errors_to_report in term_constr_errors.m.
% Although there are differences in the data types they operate on
% and the options they consult, any changes here probably require
% corresponding changes there as well.
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, termination_check, NormalErrors),
globals.lookup_bool_option(Globals, termination_check_verbose,
VerboseErrors),
( if
IsCheckTerm =
( pred(PPId::in) is semidet :-
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _),
not pred_info_is_imported(PredInfo),
pred_info_get_markers(PredInfo, Markers),
check_marker(Markers, marker_check_termination)
),
set.filter(IsCheckTerm, SCC, CheckTermPPIds),
set.is_non_empty(CheckTermPPIds)
then
% If any procedure in the SCC has a check_terminates pragma,
% print out one error message for the whole SCC and indicate an error.
MaybeErrorsToReport = yes(Errors)
else if
IsNonImported =
( pred(PPId::in) is semidet :-
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _),
not pred_info_is_imported(PredInfo)
),
set.filter(IsNonImported, SCC, NonImportedPPIds),
set.is_non_empty(NonImportedPPIds)
then
(
VerboseErrors = yes,
% If verbose errors is enabled, then output both direct and
% indirect errors.
% (See term_errors.m for details of direct and indirect errors.)
MaybeErrorsToReport = yes(Errors)
;
VerboseErrors = no,
(
NormalErrors = yes,
% We prefer reporting only the direct errors, but if there are
% no direct errors, then output all the errors, which will then
% all be indirect errors. This is better than giving no error
% at all, which would lead to a message reporting that
% termination could not be proven for "unknown reasons".
IsDirect =
( pred(Error::in) is semidet :-
Error = term_error(_, ErrorKind),
term_error_kind_is_direct_error(ErrorKind) = yes
),
list.filter(IsDirect, Errors, DirectErrors),
(
DirectErrors = [],
MaybeErrorsToReport = yes(Errors)
;
DirectErrors = [_ | _],
MaybeErrorsToReport = yes(DirectErrors)
)
;
NormalErrors = no,
MaybeErrorsToReport = no
)
)
else
MaybeErrorsToReport = no
).
%----------------------------------------------------------------------------%
% This predicate preprocesses each predicate and sets the termination
% property if possible. This is done as follows.
%
% Set the termination to yes if:
% - there is a terminates pragma defined for the predicate.
% - there is a `check_termination' pragma defined for the predicate,
% and it is imported, and the compiler is not currently generating
% the intermodule optimization file.
% - the predicate is a builtin predicate or is compiler generated (This
% also sets the termination constant and UsedArgs).
%
% Set the termination to dont_know if:
% - there is a `does_not_terminate' pragma defined for this predicate.
% - the predicate is imported and there is no other source of
% information about it (termination_info pragmas, terminates pragmas,
% check_termination pragmas, builtin/compiler generated).
%
:- pred term_preprocess_preds(maybe_believe_check_termination::in,
list(pred_id)::in, module_info::in, module_info::out) is det.
term_preprocess_preds(_, [], !ModuleInfo).
term_preprocess_preds(BelieveCheckTerm, [PredId | PredIds], !ModuleInfo) :-
term_preprocess_pred(BelieveCheckTerm, PredId, !ModuleInfo),
term_preprocess_preds(BelieveCheckTerm, PredIds, !ModuleInfo).
:- pred term_preprocess_pred(maybe_believe_check_termination::in,
pred_id::in, module_info::in, module_info::out) is det.
term_preprocess_pred(BelieveCheckTerm, PredId, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
pred_info_get_status(PredInfo0, PredStatus),
pred_info_get_context(PredInfo0, Context),
pred_info_get_proc_table(PredInfo0, ProcTable0),
pred_info_get_markers(PredInfo0, Markers),
ProcIds = pred_info_valid_procids(PredInfo0),
( if
% It is possible for compiler generated/mercury builtin
% predicates to be imported or locally defined, so they
% must be covered here, separately.
set_compiler_gen_terminates(!.ModuleInfo, PredInfo0, ProcIds, PredId,
ProcTable0, ProcTable1)
then
ProcTable2 = ProcTable1
else if
pred_status_defined_in_this_module(PredStatus) = yes
then
% Since we cannot see their definition, we consider procedures
% which have a `:- pragma external_{pred/func}' to be imported.
( if check_marker(Markers, marker_terminates) then
change_procs_termination_info(ProcIds, yes, cannot_loop(unit),
ProcTable0, ProcTable2)
else
ProcTable2 = ProcTable0
)
else
% Not defined in this module.
% All of the predicates that are processed in this section are imported
% in some way. With imported predicates, any 'check_termination'
% pragmas will be checked by the compiler when it compiles the
% relevant source file (that the predicate was imported from).
% When making the intermodule optimizations, the check_termination
% will not be checked when the relevant source file is compiled,
% so it cannot be depended upon.
( if
(
check_marker(Markers, marker_terminates)
;
BelieveCheckTerm = do_believe_check_termination,
check_marker(Markers, marker_check_termination)
)
then
change_procs_termination_info(ProcIds, yes, cannot_loop(unit),
ProcTable0, ProcTable1)
else
TerminationError = term_error(Context, imported_pred),
TerminationInfo = can_loop([TerminationError]),
change_procs_termination_info(ProcIds, no, TerminationInfo,
ProcTable0, ProcTable1)
),
ArgSizeError = term_error(Context, imported_pred),
ArgSizeInfo = infinite([ArgSizeError]),
change_procs_arg_size_info(ProcIds, no, ArgSizeInfo,
ProcTable1, ProcTable2)
),
( if check_marker(Markers, marker_does_not_terminate) then
RequestError = term_error(Context, does_not_term_pragma(PredId)),
RequestTerminationInfo = can_loop([RequestError]),
change_procs_termination_info(ProcIds, yes,
RequestTerminationInfo, ProcTable2, ProcTable)
else
ProcTable = ProcTable2
),
pred_info_set_proc_table(ProcTable, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
%----------------------------------------------------------------------------%
% This predicate checks each ProcId in the list to see if it is a compiler
% generated predicate, or a predicate from builtin.m or private_builtin.m.
% If it is, then the compiler sets the termination property of the ProcIds
% accordingly.
%
% We assume that user-defined special predicates terminate. This assumption
% is checked later during the post_term_analysis pass.
%
:- pred set_compiler_gen_terminates(module_info::in, pred_info::in,
list(proc_id)::in, pred_id::in, proc_table::in, proc_table::out)
is semidet.
set_compiler_gen_terminates(ModuleInfo, PredInfo, ProcIds, PredId,
!ProcTable) :-
% XXX This code looks to be a near-identical copy of the predicate
% of the same name in term_constr_initial.m.
( if
pred_info_is_builtin(PredInfo)
then
set_builtin_terminates(ProcIds, PredId, PredInfo, ModuleInfo,
!ProcTable)
else if
% XXX The origin test should be the only one needed;
% we should pay no attention to the name.
( if
ModuleName = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
Arity = pred_info_orig_arity(PredInfo),
special_pred_name_arity(SpecPredId0, Name, _, Arity),
any_mercury_builtin_module(ModuleName)
then
SpecialPredId = SpecPredId0
else
pred_info_get_origin(PredInfo, Origin),
Origin = origin_compiler(made_for_uci(SpecialPredId, _))
)
then
set_generated_terminates(ProcIds, SpecialPredId, !ProcTable)
else
fail
).
:- pred set_generated_terminates(list(proc_id)::in, special_pred_id::in,
proc_table::in, proc_table::out) is det.
set_generated_terminates([], _, !ProcTable).
set_generated_terminates([ProcId | ProcIds], SpecialPredId, !ProcTable) :-
map.lookup(!.ProcTable, ProcId, ProcInfo0),
proc_info_get_headvars(ProcInfo0, HeadVars),
special_pred_id_to_termination(SpecialPredId, HeadVars,
ArgSize, Termination),
proc_info_set_maybe_arg_size_info(yes(ArgSize), ProcInfo0, ProcInfo1),
proc_info_set_maybe_termination_info(yes(Termination),
ProcInfo1, ProcInfo),
map.det_update(ProcId, ProcInfo, !ProcTable),
set_generated_terminates(ProcIds, SpecialPredId, !ProcTable).
% XXX The ArgSize argument for unify predicates may not be correct
% in the case where the type has user-defined equality.
%
:- pred special_pred_id_to_termination(special_pred_id::in,
prog_vars::in, arg_size_info::out, termination_info::out) is det.
special_pred_id_to_termination(SpecialPredId, HeadVars, ArgSize,
Termination) :-
(
SpecialPredId = spec_pred_compare,
term_util.make_bool_list(HeadVars, [no, no, no], OutList),
ArgSize = finite(0, OutList),
Termination = cannot_loop(unit)
;
SpecialPredId = spec_pred_unify,
term_util.make_bool_list(HeadVars, [yes, yes], OutList),
ArgSize = finite(0, OutList),
Termination = cannot_loop(unit)
;
SpecialPredId = spec_pred_index,
term_util.make_bool_list(HeadVars, [no, no], OutList),
ArgSize = finite(0, OutList),
Termination = cannot_loop(unit)
).
% The list of proc_ids must refer to builtin predicates. This predicate
% sets the termination information of builtin predicates.
%
:- pred set_builtin_terminates(list(proc_id)::in, pred_id::in, pred_info::in,
module_info::in, proc_table::in, proc_table::out) is det.
set_builtin_terminates([], _, _, _, !ProcTable).
set_builtin_terminates([ProcId | ProcIds], PredId, PredInfo, ModuleInfo,
!ProcTable) :-
map.lookup(!.ProcTable, ProcId, ProcInfo0),
( if all_args_input_or_zero_size(ModuleInfo, PredInfo, ProcInfo0) then
% The size of the output arguments will all be 0, independent of the
% size of the input variables.
% UsedArgs should be set to yes([no, no, ...]).
proc_info_get_headvars(ProcInfo0, HeadVars),
term_util.make_bool_list(HeadVars, [], UsedArgs),
ArgSizeInfo = yes(finite(0, UsedArgs))
else
pred_info_get_context(PredInfo, Context),
Error = is_builtin(PredId),
ArgSizeError = term_error(Context, Error),
ArgSizeInfo = yes(infinite([ArgSizeError]))
),
% XXX intermod
proc_info_set_maybe_arg_size_info(ArgSizeInfo, ProcInfo0, ProcInfo1),
proc_info_set_maybe_termination_info(yes(cannot_loop(unit)),
ProcInfo1, ProcInfo),
map.det_update(ProcId, ProcInfo, !ProcTable),
set_builtin_terminates(ProcIds, PredId, PredInfo, ModuleInfo, !ProcTable).
%----------------------------------------------------------------------------%
% This predicate sets the arg_size_info property of the given list of
% procedures.
%
% change_procs_arg_size_info(ProcList, Override, TerminationInfo,
% ProcTable, ProcTable)
%
% If Override is yes, then this predicate overrides any existing arg_size
% information. If Override is no, then it leaves the proc_info of a
% procedure unchanged unless the proc_info had no arg_size information
% (i.e. the maybe(arg_size_info) field was set to "no").
%
:- pred change_procs_arg_size_info(list(proc_id)::in, bool::in,
arg_size_info::in, proc_table::in, proc_table::out) is det.
change_procs_arg_size_info([], _, _, !ProcTable).
change_procs_arg_size_info([ProcId | ProcIds], Override, ArgSize,
!ProcTable) :-
map.lookup(!.ProcTable, ProcId, ProcInfo0),
( if
( Override = yes
; proc_info_get_maybe_arg_size_info(ProcInfo0, no)
)
then
proc_info_set_maybe_arg_size_info(yes(ArgSize), ProcInfo0, ProcInfo),
map.det_update(ProcId, ProcInfo, !ProcTable)
else
true
),
change_procs_arg_size_info(ProcIds, Override, ArgSize, !ProcTable).
% change_procs_termination_info(ProcList, Override, TerminationInfo,
% !ProcTable):
%
% This predicate sets the termination_info property of the given list of
% procedures.
%
% If Override is yes, then this predicate overrides any existing
% termination information. If Override is no, then it leaves the proc_info
% of a procedure unchanged unless the proc_info had no termination
% information (i.e. the maybe(termination_info) field was set to "no").
%
:- pred change_procs_termination_info(list(proc_id)::in, bool::in,
termination_info::in, proc_table::in, proc_table::out) is det.
change_procs_termination_info([], _, _, !ProcTable).
change_procs_termination_info([ProcId | ProcIds], Override, Termination,
!ProcTable) :-
map.lookup(!.ProcTable, ProcId, ProcInfo0),
( if
(
Override = yes
;
proc_info_get_maybe_termination_info(ProcInfo0, no)
)
then
% XXX intermod
proc_info_set_maybe_termination_info(yes(Termination),
ProcInfo0, ProcInfo),
map.det_update(ProcId, ProcInfo, !ProcTable)
else
true
),
change_procs_termination_info(ProcIds, Override, Termination, !ProcTable).
%-----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
:- end_module transform_hlds.termination.
%----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink