mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-16 22:35:41 +00:00
Code Issues Projects Releases Wiki Activity

Rename apart some duplicated type and predicate names.

Browse Source 
compiler/hlds_pred.m:
    Define the type scc, so that exception_analysis.m, tabling_analysis.m
    and trailing_analysis.m don't have their own identical definitions.

compiler/term_constr_pass2.m:
    Rename the (different) scc type defined here to avoid a name collision.

compiler/exception_analysis.m:
compiler/tabling_analysis.m:
compiler/trailing_analysis.m:
    Delete the repeated definitions of the scc type. Rename the types, fields
    and predicates whose names are repeated in each of these modules, so that
    they are unique to each module.
This commit is contained in:
Zoltan Somogyi
2015-09-24 06:51:09 +10:00
parent 74f4738402
commit b8e296aa6b
5 changed files with 412 additions and 377 deletions
Download Patch File Download Diff File Expand all files Collapse all files

348
compiler/exception_analysis.m
View File

@@ -193,28 +193,24 @@ analyse_exceptions_in_module(!ModuleInfo, !IO) :-
% Perform exception analysis on a SCC.
%
:- type scc == list(pred_proc_id).
:- type proc_results == list(proc_result).
:- type proc_result
---> proc_result(
:- type excp_proc_result
---> excp_proc_result(
% The ppid of the procedure whose analysis results are
% stored in this structure.
ppid :: pred_proc_id,
epr_ppid :: pred_proc_id,
% Exception status of this procedure not counting any input
% from (mutually-)recursive inputs.
status :: exception_status,
epr_status :: exception_status,
% The collective type status of the types of the terms that
% are arguments of (mutually-)recursive calls.
rec_calls :: type_status,
epr_rec_calls :: type_excp_status,
% The analysis status used for intermodule-analysis.
% This should be `no' if we are not compiling with
% intermodule analysis enabled.
maybe_analysis_status :: maybe(analysis_status)
epr_maybe_analysis_status :: maybe(analysis_status)
).
:- pred check_scc_for_exceptions(scc::in,
@@ -225,7 +221,8 @@ check_scc_for_exceptions(SCC, !ModuleInfo) :-
% The `Results' above are the results of analysing each individual
% procedure in the SCC - we now have to combine them in a meaningful way.
combine_individual_proc_results(ProcResults, Status, MaybeAnalysisStatus),
excp_combine_individual_proc_results(ProcResults, Status,
MaybeAnalysisStatus),
ProcExceptionInfo = proc_exception_info(Status, MaybeAnalysisStatus),
list.foldl(set_exception_info(ProcExceptionInfo), SCC, !ModuleInfo).
@@ -240,7 +237,7 @@ set_exception_info(ProcExceptionInfo, PPId, !ModuleInfo) :-
% Check each procedure in the SCC individually.
%
:- pred check_procs_for_exceptions(scc::in, proc_results::out,
:- pred check_procs_for_exceptions(scc::in, list(excp_proc_result)::out,
module_info::in, module_info::out) is det.
check_procs_for_exceptions(SCC, Result, !ModuleInfo) :-
@@ -250,12 +247,12 @@ check_procs_for_exceptions(SCC, Result, !ModuleInfo) :-
% Examine how procedures interact with other procedures that are
% mutually-recursive to them.
%
:- pred combine_individual_proc_results(proc_results::in,
:- pred excp_combine_individual_proc_results(list(excp_proc_result)::in,
exception_status::out, maybe(analysis_status)::out) is det.
combine_individual_proc_results([], _, _) :-
excp_combine_individual_proc_results([], _, _) :-
unexpected($module, $pred, "Empty SCC during exception analysis.").
combine_individual_proc_results(ProcResults @ [_|_], SCC_Result,
excp_combine_individual_proc_results(ProcResults @ [_ | _], SCC_Result,
MaybeAnalysisStatus) :-
( if
% If none of the procedures may throw an exception or are conditional
@@ -263,7 +260,7 @@ combine_individual_proc_results(ProcResults @ [_|_], SCC_Result,
all [ProcResult] (
list.member(ProcResult, ProcResults)
=>
ProcResult ^ status = will_not_throw
ProcResult ^ epr_status = will_not_throw
)
then
SCC_Result = will_not_throw
@@ -280,11 +277,11 @@ combine_individual_proc_results(ProcResults @ [_|_], SCC_Result,
all [EResult] (
list.member(EResult, ProcResults)
=>
EResult ^ status \= may_throw(_)
EResult ^ epr_status \= may_throw(_)
),
some [CResult] (
list.member(CResult, ProcResults),
CResult ^ status = throw_conditional
CResult ^ epr_status = throw_conditional
)
then
SCC_Result = handle_mixed_conditional_scc(ProcResults)
@@ -296,37 +293,37 @@ combine_individual_proc_results(ProcResults @ [_|_], SCC_Result,
all [EResult] (
list.member(EResult, ProcResults)
=>
EResult ^ status \= may_throw(user_exception)
EResult ^ epr_status \= may_throw(user_exception)
),
some [TResult] (
list.member(TResult, ProcResults),
TResult ^ status = may_throw(type_exception)
TResult ^ epr_status = may_throw(type_exception)
)
then
SCC_Result = may_throw(type_exception)
else
SCC_Result = may_throw(user_exception)
),
combine_proc_result_maybe_analysis_statuses(ProcResults,
excp_combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus).
% XXX There is some code duplication with trailing_analysis.m here ...
% we should factor out this code into a utility module for
% intermodule-analysis at some point.
%
:- pred combine_proc_result_maybe_analysis_statuses(proc_results::in,
maybe(analysis_status)::out) is det.
:- pred excp_combine_proc_result_maybe_analysis_statuses(
list(excp_proc_result)::in, maybe(analysis_status)::out) is det.
combine_proc_result_maybe_analysis_statuses(ProcResults,
excp_combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus) :-
list.map(maybe_analysis_status, ProcResults, MaybeAnalysisStatuses),
list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
yes(optimal), MaybeAnalysisStatus).
:- pred maybe_analysis_status(proc_result::in, maybe(analysis_status)::out)
is det.
:- pred maybe_analysis_status(excp_proc_result::in,
maybe(analysis_status)::out) is det.
maybe_analysis_status(ProcResult, ProcResult ^ maybe_analysis_status).
maybe_analysis_status(ProcResult, ProcResult ^ epr_maybe_analysis_status).
%----------------------------------------------------------------------------%
%
@@ -334,8 +331,8 @@ maybe_analysis_status(ProcResult, ProcResult ^ maybe_analysis_status).
%
:- pred check_proc_for_exceptions(scc::in, pred_proc_id::in,
proc_results::in, proc_results::out, module_info::in, module_info::out)
is det.
list(excp_proc_result)::in, list(excp_proc_result)::out,
module_info::in, module_info::out) is det.
check_proc_for_exceptions(SCC, PPId, !Results, !ModuleInfo) :-
module_info_pred_proc_info(!.ModuleInfo, PPId, _, ProcInfo),
@@ -345,27 +342,28 @@ check_proc_for_exceptions(SCC, PPId, !Results, !ModuleInfo) :-
globals.lookup_bool_option(Globals, intermodule_analysis,
IntermodAnalysis),
MaybeAnalysisStatus0 = maybe_optimal(IntermodAnalysis),
Result0 = proc_result(PPId, will_not_throw, type_will_not_throw,
Result0 = excp_proc_result(PPId, will_not_throw, type_will_not_throw,
MaybeAnalysisStatus0),
check_goal_for_exceptions(SCC, VarTypes, Body, Result0, Result,
!ModuleInfo),
list.cons(Result, !Results).
:- pred check_goal_for_exceptions(scc::in, vartypes::in, hlds_goal::in,
proc_result::in, proc_result::out, module_info::in, module_info::out)
is det.
excp_proc_result::in, excp_proc_result::out,
module_info::in, module_info::out) is det.
check_goal_for_exceptions(SCC, VarTypes, hlds_goal(GoalExpr, GoalInfo),
!Result, !ModuleInfo) :-
( if goal_info_get_determinism(GoalInfo) = detism_erroneous then
!Result ^ status := may_throw(user_exception)
!Result ^ epr_status := may_throw(user_exception)
else
check_goal_for_exceptions_2(SCC, VarTypes, GoalExpr, GoalInfo,
!Result, !ModuleInfo)
).
:- pred check_goal_for_exceptions_2(scc::in, vartypes::in,
hlds_goal_expr::in, hlds_goal_info::in, proc_result::in, proc_result::out,
hlds_goal_expr::in, hlds_goal_info::in,
excp_proc_result::in, excp_proc_result::out,
module_info::in, module_info::out) is det.
check_goal_for_exceptions_2(SCC, VarTypes, GoalExpr, GoalInfo,
@@ -405,7 +403,7 @@ check_goal_for_exceptions_2(SCC, VarTypes, GoalExpr, GoalInfo,
% they will have already been processed.
(
MayThrowException = default_exception_behaviour,
!Result ^ status := may_throw(user_exception)
!Result ^ epr_status := may_throw(user_exception)
;
MayThrowException = proc_will_not_throw_exception
)
@@ -451,8 +449,8 @@ check_goal_for_exceptions_2(SCC, VarTypes, GoalExpr, GoalInfo,
:- pred check_goal_for_exceptions_plain_call(scc::in, vartypes::in,
pred_id::in, proc_id::in, list(prog_var)::in,
proc_result::in, proc_result::out, module_info::in, module_info::out)
is det.
excp_proc_result::in, excp_proc_result::out,
module_info::in, module_info::out) is det.
check_goal_for_exceptions_plain_call(SCC, VarTypes, CallPredId, CallProcId,
CallArgs, !Result, !ModuleInfo) :-
@@ -463,9 +461,10 @@ check_goal_for_exceptions_plain_call(SCC, VarTypes, CallPredId, CallProcId,
list.member(CallPPId, SCC)
then
lookup_var_types(VarTypes, CallArgs, Types),
TypeStatus = check_types(!.ModuleInfo, Types),
combine_type_status(TypeStatus, !.Result ^ rec_calls, NewTypeStatus),
!Result ^ rec_calls := NewTypeStatus
TypeStatus = excp_check_types(!.ModuleInfo, Types),
excp_combine_type_status(TypeStatus, !.Result ^ epr_rec_calls,
NewTypeStatus),
!Result ^ epr_rec_calls := NewTypeStatus
else if
pred_info_is_builtin(CallPredInfo)
then
@@ -498,17 +497,17 @@ check_goal_for_exceptions_plain_call(SCC, VarTypes, CallPredId, CallProcId,
globals.lookup_bool_option(Globals, intermodule_analysis,
IntermodAnalysis),
MaybeAnalysisStatus = maybe_optimal(IntermodAnalysis),
check_vars(!.ModuleInfo, VarTypes, CallArgs, MaybeAnalysisStatus,
excp_check_vars(!.ModuleInfo, VarTypes, CallArgs, MaybeAnalysisStatus,
!Result)
else
check_nonrecursive_call(VarTypes, CallPPId, CallArgs, CallPredInfo,
!Result, !ModuleInfo)
excp_check_nonrecursive_call(VarTypes, CallPPId, CallArgs,
CallPredInfo, !Result, !ModuleInfo)
).
:- pred check_goal_for_exceptions_generic_call(vartypes::in,
generic_call::in, list(prog_var)::in, hlds_goal_info::in,
proc_result::in, proc_result::out, module_info::in, module_info::out)
is det.
excp_proc_result::in, excp_proc_result::out,
module_info::in, module_info::out) is det.
check_goal_for_exceptions_generic_call(VarTypes, Details, Args, GoalInfo,
!Result, !ModuleInfo) :-
@@ -518,7 +517,7 @@ check_goal_for_exceptions_generic_call(VarTypes, Details, Args, GoalInfo,
(
Details = higher_order(Var, _, _, _),
ClosureValueMap = goal_info_get_ho_values(GoalInfo),
( if ClosureValues = ClosureValueMap ^ elem(Var) then
( if map.search(ClosureValueMap, Var, ClosureValues) then
get_closures_exception_status(IntermodAnalysis, ClosureValues,
MaybeWillNotThrow, MaybeAnalysisStatus, !ModuleInfo),
(
@@ -551,20 +550,20 @@ check_goal_for_exceptions_generic_call(VarTypes, Details, Args, GoalInfo,
% out-of-line unifications/comparisons occur to be able to
% do better.
check_vars(!.ModuleInfo, VarTypes, Args,
excp_check_vars(!.ModuleInfo, VarTypes, Args,
MaybeAnalysisStatus, !Result)
)
;
MaybeWillNotThrow = may_throw,
!Result ^ status := may_throw(user_exception)
!Result ^ epr_status := may_throw(user_exception)
)
else
!Result ^ status := may_throw(user_exception)
!Result ^ epr_status := may_throw(user_exception)
)
;
% XXX We could do better with class methods.
Details = class_method(_, _, _, _),
!Result ^ status := may_throw(user_exception)
!Result ^ epr_status := may_throw(user_exception)
;
Details = event_call(_)
;
@@ -572,7 +571,7 @@ check_goal_for_exceptions_generic_call(VarTypes, Details, Args, GoalInfo,
).
:- pred check_goals_for_exceptions(scc::in, vartypes::in,
hlds_goals::in, proc_result::in, proc_result::out,
list(hlds_goal)::in, excp_proc_result::in, excp_proc_result::out,
module_info::in, module_info::out) is det.
check_goals_for_exceptions(_, _, [], !Result, !ModuleInfo).
@@ -584,7 +583,7 @@ check_goals_for_exceptions(SCC, VarTypes, [Goal | Goals], !Result,
% a type exception then we still need to check that there is not a user
% exception somewhere in the rest of the SCC.
CurrentStatus = !.Result ^ status,
CurrentStatus = !.Result ^ epr_status,
(
CurrentStatus = may_throw(user_exception)
;
@@ -643,7 +642,7 @@ get_closure_exception_status(IntermodAnalysis, PPId,
IntermodAnalysis = yes,
pred_info_is_imported_not_external(PredInfo)
then
search_analysis_status(PPId, ExceptionStatus, AnalysisStatus,
search_excp_analysis_status(PPId, ExceptionStatus, AnalysisStatus,
!ModuleInfo),
MaybeAnalysisStatus = yes(AnalysisStatus)
else
@@ -676,17 +675,18 @@ get_closure_exception_status(IntermodAnalysis, PPId,
%----------------------------------------------------------------------------%
:- pred update_proc_result(exception_status::in, maybe(analysis_status)::in,
proc_result::in, proc_result::out) is det.
:- pred update_excp_proc_result(exception_status::in,
maybe(analysis_status)::in,
excp_proc_result::in, excp_proc_result::out) is det.
update_proc_result(CurrentStatus, CurrentAnalysisStatus, !Result) :-
OldStatus = !.Result ^ status,
OldAnalysisStatus = !.Result ^ maybe_analysis_status,
update_excp_proc_result(CurrentStatus, CurrentAnalysisStatus, !Result) :-
OldStatus = !.Result ^ epr_status,
OldAnalysisStatus = !.Result ^ epr_maybe_analysis_status,
NewStatus = combine_exception_status(CurrentStatus, OldStatus),
combine_maybe_analysis_status(CurrentAnalysisStatus, OldAnalysisStatus,
NewAnalysisStatus),
!Result ^ status := NewStatus,
!Result ^ maybe_analysis_status := NewAnalysisStatus.
!Result ^ epr_status := NewStatus,
!Result ^ epr_maybe_analysis_status := NewAnalysisStatus.
:- func combine_exception_status(exception_status, exception_status)
= exception_status.
@@ -720,12 +720,12 @@ combine_maybe_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
% Extra procedures for handling calls.
%
:- pred check_nonrecursive_call(vartypes::in,
:- pred excp_check_nonrecursive_call(vartypes::in,
pred_proc_id::in, prog_vars::in, pred_info::in,
proc_result::in, proc_result::out,
excp_proc_result::in, excp_proc_result::out,
module_info::in, module_info::out) is det.
check_nonrecursive_call(VarTypes, PPId, Args, PredInfo, !Result,
excp_check_nonrecursive_call(VarTypes, PPId, Args, PredInfo, !Result,
!ModuleInfo) :-
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, intermodule_analysis,
@@ -736,10 +736,10 @@ check_nonrecursive_call(VarTypes, PPId, Args, PredInfo, !Result,
IntermodAnalysis = yes,
pred_info_is_imported_not_external(PredInfo)
then
search_analysis_status(PPId, CalleeResult, AnalysisStatus,
search_excp_analysis_status(PPId, CalleeResult, AnalysisStatus,
!ModuleInfo),
MaybeAnalysisStatus = yes(AnalysisStatus),
update_proc_result(CalleeResult, MaybeAnalysisStatus, !Result)
update_excp_proc_result(CalleeResult, MaybeAnalysisStatus, !Result)
else
PPId = proc(_, ProcId),
pred_info_proc_info(PredInfo, ProcId, ProcInfo),
@@ -750,16 +750,16 @@ check_nonrecursive_call(VarTypes, PPId, Args, PredInfo, !Result,
MaybeAnalysisStatus),
(
CalleeExceptionStatus = will_not_throw,
update_proc_result(will_not_throw, MaybeAnalysisStatus,
update_excp_proc_result(will_not_throw, MaybeAnalysisStatus,
!Result)
;
CalleeExceptionStatus = may_throw(ExceptionType),
update_proc_result(may_throw(ExceptionType),
update_excp_proc_result(may_throw(ExceptionType),
MaybeAnalysisStatus, !Result)
;
CalleeExceptionStatus = throw_conditional,
check_vars(!.ModuleInfo, VarTypes, Args, MaybeAnalysisStatus,
!Result)
excp_check_vars(!.ModuleInfo, VarTypes, Args,
MaybeAnalysisStatus, !Result)
)
;
MaybeCalleeExceptionInfo = no,
@@ -767,38 +767,40 @@ check_nonrecursive_call(VarTypes, PPId, Args, PredInfo, !Result,
% then assume that it might throw an exception.
% Analysis statuses on individual results are meaningless now.
MaybeAnalysisStatus = maybe_optimal(IntermodAnalysis),
update_proc_result(may_throw(user_exception), MaybeAnalysisStatus,
!Result)
update_excp_proc_result(may_throw(user_exception),
MaybeAnalysisStatus, !Result)
)
).
:- pred check_vars(module_info::in, vartypes::in, prog_vars::in,
maybe(analysis_status)::in, proc_result::in, proc_result::out) is det.
:- pred excp_check_vars(module_info::in, vartypes::in, prog_vars::in,
maybe(analysis_status)::in, excp_proc_result::in, excp_proc_result::out)
is det.
check_vars(ModuleInfo, VarTypes, Vars, MaybeAnalysisStatus, !Result) :-
excp_check_vars(ModuleInfo, VarTypes, Vars, MaybeAnalysisStatus, !Result) :-
lookup_var_types(VarTypes, Vars, Types),
TypeStatus = check_types(ModuleInfo, Types),
TypeStatus = excp_check_types(ModuleInfo, Types),
(
TypeStatus = type_will_not_throw
;
TypeStatus = type_may_throw,
update_proc_result(may_throw(type_exception), MaybeAnalysisStatus,
update_excp_proc_result(may_throw(type_exception), MaybeAnalysisStatus,
!Result)
;
TypeStatus = type_conditional,
update_proc_result(throw_conditional, MaybeAnalysisStatus, !Result)
update_excp_proc_result(throw_conditional, MaybeAnalysisStatus,
!Result)
).
%----------------------------------------------------------------------------%
%
% Predicates for checking mixed SCCs
% Predicates for checking mixed SCCs.
%
% A "mixed SCC" is one where at least one of the procedures in the SCC is
% known not to throw an exception, at least one of them is conditional and
% none of them may throw an exception (of either sort).
%
% In order to determine the status of such a SCC we also need to take the
% In order to determine the status of such a SCC, we also need to take the
% effect of the recursive calls into account. This is because calls to a
% conditional procedure from a procedure that is mutually recursive to it may
% introduce types that could cause a type_exception to be thrown.
@@ -811,14 +813,15 @@ check_vars(ModuleInfo, VarTypes, Vars, MaybeAnalysisStatus, !Result) :-
% NOTE: it is possible to write rather contrived programs that can exhibit
% rather strange behaviour which is why all this is necessary.
:- func handle_mixed_conditional_scc(proc_results) = exception_status.
:- func handle_mixed_conditional_scc(list(excp_proc_result))
= exception_status.
handle_mixed_conditional_scc(Results) =
( if
all [TypeStatus] (
list.member(Result, Results)
=>
Result ^ rec_calls \= type_may_throw
Result ^ epr_rec_calls \= type_may_throw
)
then
throw_conditional
@@ -851,7 +854,7 @@ handle_mixed_conditional_scc(Results) =
% * If at least one of the types is conditional and none of them throw then
% the type is conditional.
:- type type_status
:- type type_excp_status
---> type_will_not_throw
% This type does not have user-defined equality
% or comparison predicates.
@@ -867,34 +870,36 @@ handle_mixed_conditional_scc(Results) =
% Return the collective type status of a list of types.
%
:- func check_types(module_info, list(mer_type)) = type_status.
:- func excp_check_types(module_info, list(mer_type)) = type_excp_status.
check_types(ModuleInfo, Types) = Status :-
list.foldl(check_type(ModuleInfo), Types, type_will_not_throw, Status).
excp_check_types(ModuleInfo, Types) = Status :-
list.foldl(excp_check_type(ModuleInfo), Types, type_will_not_throw, Status).
:- pred check_type(module_info::in, mer_type::in, type_status::in,
type_status::out) is det.
:- pred excp_check_type(module_info::in, mer_type::in, type_excp_status::in,
type_excp_status::out) is det.
check_type(ModuleInfo, Type, !Status) :-
combine_type_status(check_type(ModuleInfo, Type), !Status).
excp_check_type(ModuleInfo, Type, !Status) :-
excp_combine_type_status(excp_check_type(ModuleInfo, Type), !Status).
:- pred combine_type_status(type_status::in, type_status::in,
type_status::out) is det.
:- pred excp_combine_type_status(type_excp_status::in, type_excp_status::in,
type_excp_status::out) is det.
combine_type_status(type_will_not_throw, type_will_not_throw,
excp_combine_type_status(type_will_not_throw, type_will_not_throw,
type_will_not_throw).
combine_type_status(type_will_not_throw, type_conditional, type_conditional).
combine_type_status(type_will_not_throw, type_may_throw, type_may_throw).
combine_type_status(type_conditional, type_will_not_throw, type_conditional).
combine_type_status(type_conditional, type_conditional, type_conditional).
combine_type_status(type_conditional, type_may_throw, type_may_throw).
combine_type_status(type_may_throw, _, type_may_throw).
excp_combine_type_status(type_will_not_throw, type_conditional,
type_conditional).
excp_combine_type_status(type_will_not_throw, type_may_throw, type_may_throw).
excp_combine_type_status(type_conditional, type_will_not_throw,
type_conditional).
excp_combine_type_status(type_conditional, type_conditional, type_conditional).
excp_combine_type_status(type_conditional, type_may_throw, type_may_throw).
excp_combine_type_status(type_may_throw, _, type_may_throw).
% Return the type status of an individual type.
%
:- func check_type(module_info, mer_type) = type_status.
:- func excp_check_type(module_info, mer_type) = type_excp_status.
check_type(ModuleInfo, Type) = Status :-
excp_check_type(ModuleInfo, Type) = Status :-
( if
( type_is_solver_type(ModuleInfo, Type)
; type_is_existq_type(ModuleInfo, Type)
@@ -905,12 +910,13 @@ check_type(ModuleInfo, Type) = Status :-
Status = type_may_throw
else
TypeCategory = classify_type(ModuleInfo, Type),
Status = check_type_2(ModuleInfo, Type, TypeCategory)
Status = excp_check_type_2(ModuleInfo, Type, TypeCategory)
).
:- func check_type_2(module_info, mer_type, type_ctor_category) = type_status.
:- func excp_check_type_2(module_info, mer_type, type_ctor_category)
= type_excp_status.
check_type_2(ModuleInfo, Type, CtorCat) = WillThrow :-
excp_check_type_2(ModuleInfo, Type, CtorCat) = WillThrow :-
(
( CtorCat = ctor_cat_builtin(_)
; CtorCat = ctor_cat_higher_order
@@ -925,7 +931,7 @@ check_type_2(ModuleInfo, Type, CtorCat) = WillThrow :-
;
CtorCat = ctor_cat_tuple,
type_to_ctor_and_args_det(Type, _TypeCtor, Args),
WillThrow = check_types(ModuleInfo, Args)
WillThrow = excp_check_types(ModuleInfo, Args)
;
CtorCat = ctor_cat_enum(_),
( if type_has_user_defined_equality_pred(ModuleInfo, Type, _UC) then
@@ -942,8 +948,8 @@ check_type_2(ModuleInfo, Type, CtorCat) = WillThrow :-
% actually do. Something similar needs to be sorted out for
% termination analysis as well, so we'll wait until that is done.
WillThrow = type_may_throw
else if type_ctor_is_safe(TypeCtor) then
WillThrow = check_types(ModuleInfo, Args)
else if excp_type_ctor_is_safe(TypeCtor) then
WillThrow = excp_check_types(ModuleInfo, Args)
else
WillThrow = type_may_throw
)
@@ -957,59 +963,59 @@ check_type_2(ModuleInfo, Type, CtorCat) = WillThrow :-
% already handled above. Also, this list does not need to include
% non-abstract equivalence types.
%
:- pred type_ctor_is_safe(type_ctor::in) is semidet.
:- pred excp_type_ctor_is_safe(type_ctor::in) is semidet.
type_ctor_is_safe(TypeCtor) :-
excp_type_ctor_is_safe(TypeCtor) :-
TypeCtor = type_ctor(qualified(unqualified(ModuleName), CtorName), Arity),
type_ctor_is_safe_2(ModuleName, CtorName, Arity).
excp_type_ctor_is_safe_2(ModuleName, CtorName, Arity).
:- pred type_ctor_is_safe_2(string::in, string::in, arity::in) is semidet.
:- pred excp_type_ctor_is_safe_2(string::in, string::in, arity::in) is semidet.
type_ctor_is_safe_2("assoc_list", "assoc_list", 1).
type_ctor_is_safe_2("bag", "bag", 1).
type_ctor_is_safe_2("bimap", "bimap", 2).
type_ctor_is_safe_2("builtin", "c_pointer", 0).
type_ctor_is_safe_2("cord", "cord", 1).
type_ctor_is_safe_2("eqvclass", "eqvclass", 1).
type_ctor_is_safe_2("injection", "injection", 2).
type_ctor_is_safe_2("integer", "integer", 0).
type_ctor_is_safe_2("io", "input_stream", 0).
type_ctor_is_safe_2("io", "output_stream", 0).
type_ctor_is_safe_2("io", "binary_stream", 0).
type_ctor_is_safe_2("io", "stream_id", 0).
type_ctor_is_safe_2("io", "res", 0).
type_ctor_is_safe_2("io", "res", 1).
type_ctor_is_safe_2("io", "maybe_partial_res", 1).
type_ctor_is_safe_2("io", "result", 0).
type_ctor_is_safe_2("io", "result", 1).
type_ctor_is_safe_2("io", "read_result", 1).
type_ctor_is_safe_2("io", "error", 0).
type_ctor_is_safe_2("list", "list", 1).
type_ctor_is_safe_2("map", "map", 2).
type_ctor_is_safe_2("maybe", "maybe", 1).
type_ctor_is_safe_2("maybe_error", "maybe_error", 1).
type_ctor_is_safe_2("multi_map", "multi_map", 2).
type_ctor_is_safe_2("pair", "pair", 2).
type_ctor_is_safe_2("pqueue", "pqueue", 2).
type_ctor_is_safe_2("queue", "queue", 1).
type_ctor_is_safe_2("rational", "rational", 0).
type_ctor_is_safe_2("rbtree", "rbtree", 2).
type_ctor_is_safe_2("rtree", "rtree", 2).
type_ctor_is_safe_2("set", "set", 1).
type_ctor_is_safe_2("set_bbbtree", "set_bbbtree", 1).
type_ctor_is_safe_2("set_ctree234", "set_ctree234", 1).
type_ctor_is_safe_2("set_ordlist", "set_ordlist", 1).
type_ctor_is_safe_2("set_tree234", "set_tree234", 1).
type_ctor_is_safe_2("set_unordlist", "set_unordlist", 1).
type_ctor_is_safe_2("stack", "stack", 1).
type_ctor_is_safe_2("string", "poly_type", 0).
type_ctor_is_safe_2("string", "justified_column", 0).
type_ctor_is_safe_2("term", "term", 1).
type_ctor_is_safe_2("term", "const", 0).
type_ctor_is_safe_2("term", "context", 0).
type_ctor_is_safe_2("term", "var", 1).
type_ctor_is_safe_2("term", "var_supply", 1).
type_ctor_is_safe_2("varset", "varset", 1).
excp_type_ctor_is_safe_2("assoc_list", "assoc_list", 1).
excp_type_ctor_is_safe_2("bag", "bag", 1).
excp_type_ctor_is_safe_2("bimap", "bimap", 2).
excp_type_ctor_is_safe_2("builtin", "c_pointer", 0).
excp_type_ctor_is_safe_2("cord", "cord", 1).
excp_type_ctor_is_safe_2("eqvclass", "eqvclass", 1).
excp_type_ctor_is_safe_2("injection", "injection", 2).
excp_type_ctor_is_safe_2("integer", "integer", 0).
excp_type_ctor_is_safe_2("io", "input_stream", 0).
excp_type_ctor_is_safe_2("io", "output_stream", 0).
excp_type_ctor_is_safe_2("io", "binary_stream", 0).
excp_type_ctor_is_safe_2("io", "stream_id", 0).
excp_type_ctor_is_safe_2("io", "res", 0).
excp_type_ctor_is_safe_2("io", "res", 1).
excp_type_ctor_is_safe_2("io", "maybe_partial_res", 1).
excp_type_ctor_is_safe_2("io", "result", 0).
excp_type_ctor_is_safe_2("io", "result", 1).
excp_type_ctor_is_safe_2("io", "read_result", 1).
excp_type_ctor_is_safe_2("io", "error", 0).
excp_type_ctor_is_safe_2("list", "list", 1).
excp_type_ctor_is_safe_2("map", "map", 2).
excp_type_ctor_is_safe_2("maybe", "maybe", 1).
excp_type_ctor_is_safe_2("maybe_error", "maybe_error", 1).
excp_type_ctor_is_safe_2("multi_map", "multi_map", 2).
excp_type_ctor_is_safe_2("pair", "pair", 2).
excp_type_ctor_is_safe_2("pqueue", "pqueue", 2).
excp_type_ctor_is_safe_2("queue", "queue", 1).
excp_type_ctor_is_safe_2("rational", "rational", 0).
excp_type_ctor_is_safe_2("rbtree", "rbtree", 2).
excp_type_ctor_is_safe_2("rtree", "rtree", 2).
excp_type_ctor_is_safe_2("set", "set", 1).
excp_type_ctor_is_safe_2("set_bbbtree", "set_bbbtree", 1).
excp_type_ctor_is_safe_2("set_ctree234", "set_ctree234", 1).
excp_type_ctor_is_safe_2("set_ordlist", "set_ordlist", 1).
excp_type_ctor_is_safe_2("set_tree234", "set_tree234", 1).
excp_type_ctor_is_safe_2("set_unordlist", "set_unordlist", 1).
excp_type_ctor_is_safe_2("stack", "stack", 1).
excp_type_ctor_is_safe_2("string", "poly_type", 0).
excp_type_ctor_is_safe_2("string", "justified_column", 0).
excp_type_ctor_is_safe_2("term", "term", 1).
excp_type_ctor_is_safe_2("term", "const", 0).
excp_type_ctor_is_safe_2("term", "context", 0).
excp_type_ctor_is_safe_2("term", "var", 1).
excp_type_ctor_is_safe_2("term", "var_supply", 1).
excp_type_ctor_is_safe_2("varset", "varset", 1).
%----------------------------------------------------------------------------%
%
@@ -1019,13 +1025,13 @@ type_ctor_is_safe_2("varset", "varset", 1).
:- type exception_analysis_answer
---> exception_analysis_answer(exception_status).
:- func analysis_name = string.
:- func excp_analysis_name = string.
analysis_name = "exception_analysis".
excp_analysis_name = "exception_analysis".
:- instance analysis(no_func_info, any_call, exception_analysis_answer)
where [
analysis_name(_, _) = analysis_name,
analysis_name(_, _) = excp_analysis_name,
analysis_version_number(_, _) = 1,
preferred_fixpoint_type(_, _) = least_fixpoint,
bottom(_, _) = exception_analysis_answer(will_not_throw),
@@ -1054,20 +1060,21 @@ exception_status_more_precise_than(may_throw(type_exception),
may_throw(user_exception)).
:- instance to_term(exception_analysis_answer) where [
func(to_term/1) is answer_to_term,
pred(from_term/2) is answer_from_term
func(to_term/1) is excp_answer_to_term,
pred(from_term/2) is excp_answer_from_term
].
:- func answer_to_term(exception_analysis_answer) = term.
:- func excp_answer_to_term(exception_analysis_answer) = term.
answer_to_term(Answer) = Term :-
excp_answer_to_term(Answer) = Term :-
Answer = exception_analysis_answer(Status),
exception_status_to_string(Status, String),
Term = term.functor(atom(String), [], context_init).
:- pred answer_from_term(term::in, exception_analysis_answer::out) is semidet.
:- pred excp_answer_from_term(term::in, exception_analysis_answer::out)
is semidet.
answer_from_term(Term, exception_analysis_answer(Status)) :-
excp_answer_from_term(Term, exception_analysis_answer(Status)) :-
Term = term.functor(atom(String), [], _),
exception_status_to_string(Status, String).
@@ -1087,21 +1094,21 @@ exception_status_to_string(may_throw(user_exception),
% Additional predicates used for intermodule analysis.
%
:- pred search_analysis_status(pred_proc_id::in,
:- pred search_excp_analysis_status(pred_proc_id::in,
exception_status::out, analysis_status::out,
module_info::in, module_info::out) is det.
search_analysis_status(PPId, Result, AnalysisStatus, !ModuleInfo) :-
search_excp_analysis_status(PPId, Result, AnalysisStatus, !ModuleInfo) :-
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
search_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
search_excp_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
AnalysisInfo0, AnalysisInfo),
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
:- pred search_analysis_status_2(module_info::in, pred_proc_id::in,
:- pred search_excp_analysis_status_2(module_info::in, pred_proc_id::in,
exception_status::out, analysis_status::out,
analysis_info::in, analysis_info::out) is det.
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
search_excp_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
!AnalysisInfo) :-
module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
Call = any_call,
@@ -1120,7 +1127,8 @@ search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
top(no_func_info, Call) = Answer,
Answer = exception_analysis_answer(Result),
AnalysisStatus = optimal,
record_request(analysis_name, ModuleName, FuncId, Call, !AnalysisInfo)
record_request(excp_analysis_name, ModuleName, FuncId, Call,
!AnalysisInfo)
).
:- pred maybe_record_exception_result(module_info::in, pred_id::in,

6
compiler/hlds_pred.m
View File

@@ -85,6 +85,12 @@
:- type pred_proc_id
---> proc(pred_id, proc_id).
% Several passes operate on the module one SCC at a time. An SCC is
% a strongly connected component of the call graph, i.e. a group of
% procedures that all recursively call each other, directly or indirectly,
% which aren't mutually recursive with any procedure outside the SCC.
:- type scc == list(pred_proc_id).
% Predicate and procedure ids are abstract data types. One important
% advantage of this arrangement is to make it harder to accidentally
% confuse them for each other, or to use an integer in their place.

185
compiler/tabling_analysis.m
View File

@@ -164,18 +164,14 @@ analyse_mm_tabling_in_module(!ModuleInfo, !IO) :-
%----------------------------------------------------------------------------%
%
% Perform minimal model tabling analysis on a SCC
% Perform minimal model tabling analysis on a SCC.
%
:- type scc == list(pred_proc_id).
:- type proc_results == list(proc_result).
:- type proc_result
---> proc_result(
ppid :: pred_proc_id,
status :: mm_tabling_status,
maybe_analysis_status :: maybe(analysis_status)
:- type mm_tabling_proc_result
---> mm_tabling_proc_result(
mtpr_ppid :: pred_proc_id,
mtpr_status :: mm_tabling_status,
mtpr_maybe_analysis_status :: maybe(analysis_status)
).
:- pred analyse_mm_tabling_in_scc(bool::in, bool::in, scc::in,
@@ -185,7 +181,7 @@ analyse_mm_tabling_in_scc(Debug, Pass1Only, SCC, !ModuleInfo) :-
% Begin by analysing each procedure in the SCC.
list.foldl2(check_proc_for_mm_tabling(SCC), SCC, [], ProcResults,
!ModuleInfo),
combine_individual_proc_results(ProcResults, TablingStatus,
mm_tabling_combine_individual_proc_results(ProcResults, TablingStatus,
MaybeAnalysisStatus),
% Print out debugging information.
@@ -203,7 +199,7 @@ analyse_mm_tabling_in_scc(Debug, Pass1Only, SCC, !ModuleInfo) :-
list.foldl(set_mm_tabling_info(ProcTablingInfo), SCC, !ModuleInfo),
(
Pass1Only = no,
list.foldl(annotate_proc, SCC, !ModuleInfo)
list.foldl(mm_tabling_annotate_proc, SCC, !ModuleInfo)
;
Pass1Only = yes
).
@@ -219,12 +215,13 @@ set_mm_tabling_info(ProcTablingInfo, PPId, !ModuleInfo) :-
% Examine how procedures interact with other procedures that are
% mutually-recursive to them.
%
:- pred combine_individual_proc_results(proc_results::in,
:- pred mm_tabling_combine_individual_proc_results(
list(mm_tabling_proc_result)::in,
mm_tabling_status::out, maybe(analysis_status)::out) is det.
combine_individual_proc_results([], _, _) :-
mm_tabling_combine_individual_proc_results([], _, _) :-
unexpected($module, $pred, "empty SCC").
combine_individual_proc_results(ProcResults @ [_ | _], SCC_Result,
mm_tabling_combine_individual_proc_results(ProcResults @ [_ | _], SCC_Result,
MaybeAnalysisStatus) :-
( if
% If none of the procedures calls tabled procedures or is conditional
@@ -232,7 +229,7 @@ combine_individual_proc_results(ProcResults @ [_ | _], SCC_Result,
all [ProcResult] (
list.member(ProcResult, ProcResults)
=>
ProcResult ^ status = mm_tabled_will_not_call
ProcResult ^ mtpr_status = mm_tabled_will_not_call
)
then
SCC_Result = mm_tabled_will_not_call
@@ -240,11 +237,11 @@ combine_individual_proc_results(ProcResults @ [_ | _], SCC_Result,
all [ProcResult] (
list.member(ProcResult, ProcResults)
=>
ProcResult ^ status \= mm_tabled_may_call
ProcResult ^ mtpr_status \= mm_tabled_may_call
),
some [ConditionalResult] (
list.member(ConditionalResult, ProcResults),
ConditionalResult ^ status = mm_tabled_conditional
ConditionalResult ^ mtpr_status = mm_tabled_conditional
)
then
SCC_Result = mm_tabled_conditional
@@ -252,29 +249,32 @@ combine_individual_proc_results(ProcResults @ [_ | _], SCC_Result,
% Otherwise the SCC might call tabled procedures.
SCC_Result = mm_tabled_may_call
),
combine_proc_result_maybe_analysis_statuses(ProcResults,
mm_tabling_combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus).
:- pred combine_proc_result_maybe_analysis_statuses(proc_results::in,
maybe(analysis_status)::out) is det.
:- pred mm_tabling_combine_proc_result_maybe_analysis_statuses(
list(mm_tabling_proc_result)::in, maybe(analysis_status)::out) is det.
combine_proc_result_maybe_analysis_statuses(ProcResults,
mm_tabling_combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus) :-
list.map(maybe_analysis_status, ProcResults, MaybeAnalysisStatuses),
list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
list.map(maybe_mm_tabling_analysis_status, ProcResults,
MaybeAnalysisStatuses),
list.foldl(combine_maybe_mm_tabling_analysis_status, MaybeAnalysisStatuses,
yes(optimal), MaybeAnalysisStatus).
:- pred maybe_analysis_status(proc_result::in, maybe(analysis_status)::out)
is det.
:- pred maybe_mm_tabling_analysis_status(mm_tabling_proc_result::in,
maybe(analysis_status)::out) is det.
maybe_analysis_status(ProcResult, ProcResult ^ maybe_analysis_status).
maybe_mm_tabling_analysis_status(ProcResult, MaybeAnalysisStatus) :-
MaybeAnalysisStatus = ProcResult ^ mtpr_maybe_analysis_status.
%----------------------------------------------------------------------------%
% Perform minimal model tabling analysis on a procedure.
%
:- pred check_proc_for_mm_tabling(scc::in, pred_proc_id::in, proc_results::in,
proc_results::out, module_info::in, module_info::out) is det.
:- pred check_proc_for_mm_tabling(scc::in, pred_proc_id::in,
list(mm_tabling_proc_result)::in, list(mm_tabling_proc_result)::out,
module_info::in, module_info::out) is det.
check_proc_for_mm_tabling(SCC, PPId, !Results, !ModuleInfo) :-
module_info_pred_proc_info(!.ModuleInfo, PPId, _, ProcInfo),
@@ -294,7 +294,8 @@ check_proc_for_mm_tabling(SCC, PPId, !Results, !ModuleInfo) :-
check_goal_for_mm_tabling(SCC, VarTypes, Body, Result,
MaybeAnalysisStatus, !ModuleInfo)
),
list.cons(proc_result(PPId, Result, MaybeAnalysisStatus), !Results).
list.cons(mm_tabling_proc_result(PPId, Result, MaybeAnalysisStatus),
!Results).
%----------------------------------------------------------------------------%
@@ -394,7 +395,7 @@ check_goals_for_mm_tabling(SCC, VarTypes, Goals, Result, MaybeAnalysisStatus,
Results, MaybeAnalysisStatuses, !ModuleInfo),
list.foldl(combine_mm_tabling_status, Results, mm_tabled_will_not_call,
Result),
list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
list.foldl(combine_maybe_mm_tabling_analysis_status, MaybeAnalysisStatuses,
yes(optimal), MaybeAnalysisStatus).
%----------------------------------------------------------------------------%
@@ -451,8 +452,8 @@ check_call_for_mm_tabling(CalleePPId, CallArgs, SCC, VarTypes, Result,
% Use the intermodule analysis framework if this is an imported
% procedure and `--intermodule-analysis' is enabled.
%
search_analysis_status(CalleePPId, Result0, AnalysisStatus,
!ModuleInfo),
search_mm_tabling_analysis_status(CalleePPId, Result0,
AnalysisStatus, !ModuleInfo),
(
Result0 = mm_tabled_conditional,
% XXX user-defined uc
@@ -537,10 +538,11 @@ combine_mm_tabling_status(mm_tabled_conditional, mm_tabled_conditional,
combine_mm_tabling_status(mm_tabled_conditional, mm_tabled_may_call,
mm_tabled_may_call).
:- pred combine_maybe_analysis_status(maybe(analysis_status)::in,
:- pred combine_maybe_mm_tabling_analysis_status(maybe(analysis_status)::in,
maybe(analysis_status)::in, maybe(analysis_status)::out) is det.
combine_maybe_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
combine_maybe_mm_tabling_analysis_status(MaybeStatusA, MaybeStatusB,
MaybeStatus) :-
( if
MaybeStatusA = yes(StatusA),
MaybeStatusB = yes(StatusB)
@@ -559,25 +561,26 @@ combine_maybe_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
% `will_not_call_mm_tabled' feature to the goal_infos of those goals that
% do not make calls to minimal model tabled procedures.
%
:- pred annotate_proc(pred_proc_id::in, module_info::in, module_info::out)
is det.
:- pred mm_tabling_annotate_proc(pred_proc_id::in,
module_info::in, module_info::out) is det.
annotate_proc(PPId, !ModuleInfo) :-
mm_tabling_annotate_proc(PPId, !ModuleInfo) :-
some [!ProcInfo, !Body] (
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, !:ProcInfo),
proc_info_get_goal(!.ProcInfo, !:Body),
proc_info_get_vartypes(!.ProcInfo, VarTypes),
annotate_goal(VarTypes, !Body, _Status, !ModuleInfo),
proc_info_set_goal(!.Body, !ProcInfo),
module_info_set_pred_proc_info(PPId, PredInfo, !.ProcInfo, !ModuleInfo)
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, !:ProcInfo),
proc_info_get_goal(!.ProcInfo, !:Body),
proc_info_get_vartypes(!.ProcInfo, VarTypes),
mm_tabling_annotate_goal(VarTypes, !Body, _Status, !ModuleInfo),
proc_info_set_goal(!.Body, !ProcInfo),
module_info_set_pred_proc_info(PPId, PredInfo, !.ProcInfo, !ModuleInfo)
).
:- pred annotate_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
:- pred mm_tabling_annotate_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
mm_tabling_status::out, module_info::in, module_info::out) is det.
annotate_goal(VarTypes, !Goal, Status, !ModuleInfo) :-
mm_tabling_annotate_goal(VarTypes, !Goal, Status, !ModuleInfo) :-
!.Goal = hlds_goal(GoalExpr0, GoalInfo0),
annotate_goal_2(VarTypes, GoalExpr0, GoalExpr, Status, !ModuleInfo),
mm_tabling_annotate_goal_2(VarTypes, GoalExpr0, GoalExpr, Status,
!ModuleInfo),
(
Status = mm_tabled_will_not_call,
goal_info_add_feature(feature_will_not_call_mm_tabled,
@@ -590,10 +593,11 @@ annotate_goal(VarTypes, !Goal, Status, !ModuleInfo) :-
),
!:Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred annotate_goal_2(vartypes::in, hlds_goal_expr::in, hlds_goal_expr::out,
mm_tabling_status::out, module_info::in, module_info::out) is det.
:- pred mm_tabling_annotate_goal_2(vartypes::in,
hlds_goal_expr::in, hlds_goal_expr::out, mm_tabling_status::out,
module_info::in, module_info::out) is det.
annotate_goal_2(VarTypes, !GoalExpr, Status, !ModuleInfo) :-
mm_tabling_annotate_goal_2(VarTypes, !GoalExpr, Status, !ModuleInfo) :-
(
!.GoalExpr = unify(_, _, _, Kind, _),
(
@@ -610,7 +614,8 @@ annotate_goal_2(VarTypes, !GoalExpr, Status, !ModuleInfo) :-
;
!.GoalExpr = plain_call(CalleePredId, CalleeProcId, CallArgs, _, _, _),
CalleePPId = proc(CalleePredId, CalleeProcId),
annotate_call(CalleePPId, CallArgs, VarTypes, Status, !ModuleInfo)
mm_tabling_annotate_call(CalleePPId, CallArgs, VarTypes, Status,
!ModuleInfo)
;
!.GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
Status = get_mm_tabling_status_from_attributes(Attributes)
@@ -632,23 +637,26 @@ annotate_goal_2(VarTypes, !GoalExpr, Status, !ModuleInfo) :-
)
;
!.GoalExpr = conj(ConjType, Conjuncts0),
annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status,
mm_tabling_annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status,
!ModuleInfo),
!:GoalExpr = conj(ConjType, Conjuncts)
;
!.GoalExpr = disj(Disjuncts0),
annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
mm_tabling_annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
!ModuleInfo),
!:GoalExpr = disj(Disjuncts)
;
!.GoalExpr = switch(Var, CanFail, Cases0),
annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo),
mm_tabling_annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo),
!:GoalExpr = switch(Var, CanFail, Cases)
;
!.GoalExpr = if_then_else(Vars, Cond0, Then0, Else0),
annotate_goal(VarTypes, Cond0, Cond, CondStatus, !ModuleInfo),
annotate_goal(VarTypes, Then0, Then, ThenStatus, !ModuleInfo),
annotate_goal(VarTypes, Else0, Else, ElseStatus, !ModuleInfo),
mm_tabling_annotate_goal(VarTypes, Cond0, Cond, CondStatus,
!ModuleInfo),
mm_tabling_annotate_goal(VarTypes, Then0, Then, ThenStatus,
!ModuleInfo),
mm_tabling_annotate_goal(VarTypes, Else0, Else, ElseStatus,
!ModuleInfo),
( if
CondStatus = mm_tabled_will_not_call,
ThenStatus = mm_tabled_will_not_call,
@@ -661,7 +669,8 @@ annotate_goal_2(VarTypes, !GoalExpr, Status, !ModuleInfo) :-
!:GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
!.GoalExpr = negation(SubGoal0),
annotate_goal(VarTypes, SubGoal0, SubGoal, Status, !ModuleInfo),
mm_tabling_annotate_goal(VarTypes, SubGoal0, SubGoal, Status,
!ModuleInfo),
!:GoalExpr = negation(SubGoal)
;
!.GoalExpr = scope(Reason, SubGoal0),
@@ -673,7 +682,8 @@ annotate_goal_2(VarTypes, !GoalExpr, Status, !ModuleInfo) :-
then
Status = mm_tabled_will_not_call
else
annotate_goal(VarTypes, SubGoal0, SubGoal, Status, !ModuleInfo),
mm_tabling_annotate_goal(VarTypes, SubGoal0, SubGoal, Status,
!ModuleInfo),
!:GoalExpr = scope(Reason, SubGoal)
)
;
@@ -681,35 +691,40 @@ annotate_goal_2(VarTypes, !GoalExpr, Status, !ModuleInfo) :-
unexpected($module, $pred, "shorthand goal")
).
:- pred annotate_goal_list(vartypes::in, hlds_goals::in, hlds_goals::out,
mm_tabling_status::out, module_info::in, module_info::out) is det.
:- pred mm_tabling_annotate_goal_list(vartypes::in,
list(hlds_goal)::in, list(hlds_goal)::out, mm_tabling_status::out,
module_info::in, module_info::out) is det.
annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo) :-
list.map2_foldl(annotate_goal(VarTypes), !Goals, Statuses, !ModuleInfo),
mm_tabling_annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo) :-
list.map2_foldl(mm_tabling_annotate_goal(VarTypes), !Goals, Statuses,
!ModuleInfo),
list.foldl(combine_mm_tabling_status, Statuses, mm_tabled_will_not_call,
Status).
:- pred annotate_cases(vartypes::in, list(case)::in, list(case)::out,
mm_tabling_status::out, module_info::in, module_info::out) is det.
:- pred mm_tabling_annotate_cases(vartypes::in,
list(case)::in, list(case)::out, mm_tabling_status::out,
module_info::in, module_info::out) is det.
annotate_cases(VarTypes, !Cases, Status, !ModuleInfo) :-
list.map2_foldl(annotate_case(VarTypes), !Cases, Statuses, !ModuleInfo),
mm_tabling_annotate_cases(VarTypes, !Cases, Status, !ModuleInfo) :-
list.map2_foldl(mm_tabling_annotate_case(VarTypes), !Cases, Statuses,
!ModuleInfo),
list.foldl(combine_mm_tabling_status, Statuses, mm_tabled_will_not_call,
Status).
:- pred annotate_case(vartypes::in, case::in, case::out,
:- pred mm_tabling_annotate_case(vartypes::in, case::in, case::out,
mm_tabling_status::out, module_info::in, module_info::out)
is det.
annotate_case(VarTypes, !Case, Status, !ModuleInfo) :-
mm_tabling_annotate_case(VarTypes, !Case, Status, !ModuleInfo) :-
!.Case = case(MainConsId, OtherConsIds, Goal0),
annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo),
mm_tabling_annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo),
!:Case = case(MainConsId, OtherConsIds, Goal).
:- pred annotate_call(pred_proc_id::in, prog_vars::in, vartypes::in,
:- pred mm_tabling_annotate_call(pred_proc_id::in, prog_vars::in, vartypes::in,
mm_tabling_status::out, module_info::in, module_info::out) is det.
annotate_call(CalleePPId, CallArgs, VarTypes, Status, !ModuleInfo) :-
mm_tabling_annotate_call(CalleePPId, CallArgs, VarTypes, Status,
!ModuleInfo) :-
CalleePPId = proc(CalleePredId, _),
module_info_pred_info(!.ModuleInfo, CalleePredId, CalleePredInfo),
( if
@@ -739,8 +754,8 @@ annotate_call(CalleePPId, CallArgs, VarTypes, Status, !ModuleInfo) :-
IntermodAnalysis = yes,
pred_info_is_imported_not_external(CalleePredInfo)
then
search_analysis_status(CalleePPId, Result, AnalysisStatus,
!ModuleInfo),
search_mm_tabling_analysis_status(CalleePPId, Result,
AnalysisStatus, !ModuleInfo),
(
AnalysisStatus = invalid,
unexpected($module, $pred,
@@ -781,13 +796,13 @@ annotate_call(CalleePPId, CallArgs, VarTypes, Status, !ModuleInfo) :-
:- type mm_tabling_analysis_answer
---> mm_tabling_analysis_answer(mm_tabling_status).
:- func analysis_name = string.
:- func mm_tabling_analysis_name = string.
analysis_name = "mm_tabling_analysis".
mm_tabling_analysis_name = "mm_tabling_analysis".
:- instance analysis(no_func_info, any_call, mm_tabling_analysis_answer) where
[
analysis_name(_, _) = analysis_name,
analysis_name(_, _) = mm_tabling_analysis_name,
analysis_version_number(_, _) = 1,
preferred_fixpoint_type(_, _) = least_fixpoint,
bottom(_, _) = mm_tabling_analysis_answer(mm_tabled_will_not_call),
@@ -848,20 +863,21 @@ mm_tabling_status_to_string(mm_tabled_will_not_call,
mm_tabling_status_to_string(mm_tabled_conditional,
"mm_tabled_conditional").
:- pred search_analysis_status(pred_proc_id::in, mm_tabling_status::out,
:- pred search_mm_tabling_analysis_status(pred_proc_id::in,
mm_tabling_status::out,
analysis_status::out, module_info::in, module_info::out) is det.
search_analysis_status(PPId, Result, AnalysisStatus, !ModuleInfo) :-
search_mm_tabling_analysis_status(PPId, Result, AnalysisStatus, !ModuleInfo) :-
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
search_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
AnalysisInfo0, AnalysisInfo),
search_mm_tabling_analysis_status_2(!.ModuleInfo, PPId, Result,
AnalysisStatus, AnalysisInfo0, AnalysisInfo),
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
:- pred search_analysis_status_2(module_info::in, pred_proc_id::in,
:- pred search_mm_tabling_analysis_status_2(module_info::in, pred_proc_id::in,
mm_tabling_status::out, analysis_status::out,
analysis_info::in, analysis_info::out) is det.
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
search_mm_tabling_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
!AnalysisInfo) :-
mmc_analysis.module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
Call = any_call,
@@ -881,7 +897,8 @@ search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
top(no_func_info, Call) = Answer,
Answer = mm_tabling_analysis_answer(Result),
AnalysisStatus = optimal,
record_request(analysis_name, ModuleName, FuncId, Call, !AnalysisInfo)
record_request(mm_tabling_analysis_name, ModuleName, FuncId, Call,
!AnalysisInfo)
).
:- pred maybe_record_mm_tabling_result(module_info::in, pred_id::in,

4
compiler/term_constr_pass2.m
View File

@@ -85,7 +85,7 @@ pass2_options_init(MaxSize) = pass2_options(MaxSize).
%-----------------------------------------------------------------------------%
:- type scc == list(abstract_ppid).
:- type abstract_ppids == list(abstract_ppid).
% Each edge in the call-graph represents a single call site.
%
@@ -426,7 +426,7 @@ search_for_cycles_3(Start, SoFar, Map, Visited, Edge, !Cycles) :-
% Partitioning sets of cycles.
%
:- func partition_cycles(scc, cycles) = list(cycle_set).
:- func partition_cycles(abstract_ppids, cycles) = list(cycle_set).
partition_cycles([], _) = [].
partition_cycles([Proc | Procs], Cycles0) = CycleSets :-

246
compiler/trailing_analysis.m
View File

@@ -141,7 +141,7 @@ analyse_trail_usage(!ModuleInfo, !IO) :-
module_info_dependency_info(!.ModuleInfo, DepInfo),
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
globals.lookup_bool_option(Globals, debug_trail_usage, Debug),
list.foldl(process_scc(Debug, Pass1Only), SCCs, !ModuleInfo),
list.foldl(trail_analyse_scc(Debug, Pass1Only), SCCs, !ModuleInfo),
% Only write trailing analysis pragmas to `.opt' files for
% `--intermodule-optimization', not `--intermodule-analysis'.
@@ -177,26 +177,22 @@ analyse_trail_usage(!ModuleInfo, !IO) :-
% Perform trail usage analysis on a SCC.
%
:- type scc == list(pred_proc_id).
:- type proc_results == list(proc_result).
:- type proc_result
---> proc_result(
ppid :: pred_proc_id,
status :: trailing_status,
maybe_analysis_status :: maybe(analysis_status)
:- type trail_proc_result
---> trail_proc_result(
tpr_ppid :: pred_proc_id,
tpr_status :: trailing_status,
tpr_maybe_analysis_status :: maybe(analysis_status)
).
:- pred process_scc(bool::in, bool::in, scc::in,
:- pred trail_analyse_scc(bool::in, bool::in, scc::in,
module_info::in, module_info::out) is det.
process_scc(Debug, Pass1Only, SCC, !ModuleInfo) :-
trail_analyse_scc(Debug, Pass1Only, SCC, !ModuleInfo) :-
check_procs_for_trail_mods(SCC, ProcResults, !ModuleInfo),
% The `Results' above are the results of analysing each individual
% procedure in the SCC - we now have to combine them in a meaningful way.
combine_individual_proc_results(ProcResults,
trail_combine_individual_proc_results(ProcResults,
TrailingStatus, MaybeAnalysisStatus),
(
@@ -213,7 +209,7 @@ process_scc(Debug, Pass1Only, SCC, !ModuleInfo) :-
(
Pass1Only = no,
list.foldl(annotate_proc, SCC, !ModuleInfo)
list.foldl(trail_annotate_proc, SCC, !ModuleInfo)
;
Pass1Only = yes
).
@@ -228,7 +224,7 @@ set_trailing_info(ProcTrailingInfo, PPId, !ModuleInfo) :-
% Check each procedure in the SCC individually.
%
:- pred check_procs_for_trail_mods(scc::in, proc_results::out,
:- pred check_procs_for_trail_mods(scc::in, list(trail_proc_result)::out,
module_info::in, module_info::out) is det.
check_procs_for_trail_mods(SCC, Result, !ModuleInfo) :-
@@ -237,20 +233,20 @@ check_procs_for_trail_mods(SCC, Result, !ModuleInfo) :-
% Examine how the procedures interact with other procedures that
% are mutually-recursive to them.
%
:- pred combine_individual_proc_results(proc_results::in,
:- pred trail_combine_individual_proc_results(list(trail_proc_result)::in,
trailing_status::out, maybe(analysis_status)::out) is det.
combine_individual_proc_results([], _, _) :-
trail_combine_individual_proc_results([], _, _) :-
unexpected($module, $pred, "empty SCC").
combine_individual_proc_results(ProcResults @ [_|_],
SCC_Result, MaybeAnalysisStatus) :-
trail_combine_individual_proc_results(ProcResults @ [_ | _], SCC_Result,
MaybeAnalysisStatus) :-
( if
% If none of the procedures modifies the trail or is conditional then
% the SCC cannot modify the trail.
all [ProcResult] (
list.member(ProcResult, ProcResults)
=>
ProcResult ^ status = trail_will_not_modify
ProcResult ^ tpr_status = trail_will_not_modify
)
then
SCC_Result = trail_will_not_modify
@@ -258,11 +254,11 @@ combine_individual_proc_results(ProcResults @ [_|_],
all [EResult] (
list.member(EResult, ProcResults)
=>
EResult ^ status \= trail_may_modify
EResult ^ tpr_status \= trail_may_modify
),
some [CResult] (
list.member(CResult, ProcResults),
CResult ^ status = trail_conditional
CResult ^ tpr_status = trail_conditional
)
then
SCC_Result = trail_conditional
@@ -270,30 +266,31 @@ combine_individual_proc_results(ProcResults @ [_|_],
% Otherwise the SCC may modify the trail.
SCC_Result = trail_may_modify
),
combine_proc_result_maybe_analysis_statuses(ProcResults,
trail_combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus).
:- pred combine_proc_result_maybe_analysis_statuses(proc_results::in,
maybe(analysis_status)::out) is det.
:- pred trail_combine_proc_result_maybe_analysis_statuses(
list(trail_proc_result)::in, maybe(analysis_status)::out) is det.
combine_proc_result_maybe_analysis_statuses(ProcResults,
trail_combine_proc_result_maybe_analysis_statuses(ProcResults,
MaybeAnalysisStatus) :-
list.map(maybe_analysis_status, ProcResults, MaybeAnalysisStatuses),
list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
list.map(trail_maybe_analysis_status, ProcResults, MaybeAnalysisStatuses),
list.foldl(combine_maybe_trail_analysis_status, MaybeAnalysisStatuses,
yes(optimal), MaybeAnalysisStatus).
:- pred maybe_analysis_status(proc_result::in, maybe(analysis_status)::out)
is det.
:- pred trail_maybe_analysis_status(trail_proc_result::in,
maybe(analysis_status)::out) is det.
maybe_analysis_status(ProcResult, ProcResult ^ maybe_analysis_status).
trail_maybe_analysis_status(ProcResult, AnalysisStatus) :-
AnalysisStatus = ProcResult ^ tpr_maybe_analysis_status.
%----------------------------------------------------------------------------%
%
% Perform trail usage analysis on a procedure.
%
:- pred check_proc_for_trail_mods(scc::in,
pred_proc_id::in, proc_results::in, proc_results::out,
:- pred check_proc_for_trail_mods(scc::in, pred_proc_id::in,
list(trail_proc_result)::in, list(trail_proc_result)::out,
module_info::in, module_info::out) is det.
check_proc_for_trail_mods(SCC, PPId, !Results, !ModuleInfo) :-
@@ -302,7 +299,7 @@ check_proc_for_trail_mods(SCC, PPId, !Results, !ModuleInfo) :-
proc_info_get_vartypes(ProcInfo, VarTypes),
check_goal_for_trail_mods(SCC, VarTypes, Body,
Result, MaybeAnalysisStatus, !ModuleInfo),
list.cons(proc_result(PPId, Result, MaybeAnalysisStatus), !Results).
list.cons(trail_proc_result(PPId, Result, MaybeAnalysisStatus), !Results).
%----------------------------------------------------------------------------%
%
@@ -339,7 +336,7 @@ check_goal_for_trail_mods(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
list.member(CallPPId, SCC)
then
lookup_var_types(VarTypes, CallArgs, Types),
TrailingStatus = check_types(!.ModuleInfo, Types),
TrailingStatus = trail_check_types(!.ModuleInfo, Types),
Result = TrailingStatus,
MaybeAnalysisStatus = yes(optimal)
else if
@@ -369,7 +366,7 @@ check_goal_for_trail_mods(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
else if
% Handle library predicates whose trailing status
% can be looked up in the known procedures table.
pred_info_has_known_status(CallPredInfo, Result0)
pred_info_has_known_trail_status(CallPredInfo, Result0)
then
Result = Result0,
MaybeAnalysisStatus = yes(optimal)
@@ -381,14 +378,14 @@ check_goal_for_trail_mods(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
Intermod = yes,
pred_info_is_imported_not_external(CallPredInfo)
then
% With --intermodule-analysis use check_call_2 to look up
% With --intermodule-analysis use trail_check_call_2 to look up
% results for locally defined procedures, otherwise we use
% the intermodule analysis framework.
search_analysis_status(CallPPId, Result0, AnalysisStatus,
search_trail_analysis_status(CallPPId, Result0, AnalysisStatus,
!ModuleInfo),
(
Result0 = trail_conditional,
Result = check_vars(!.ModuleInfo, VarTypes, CallArgs)
Result = trail_check_vars(!.ModuleInfo, VarTypes, CallArgs)
;
( Result0 = trail_may_modify
; Result0 = trail_will_not_modify
@@ -397,7 +394,7 @@ check_goal_for_trail_mods(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
),
MaybeAnalysisStatus = yes(AnalysisStatus)
else
check_call_2(!.ModuleInfo, VarTypes, CallPPId, CallArgs,
trail_check_call_2(!.ModuleInfo, VarTypes, CallPPId, CallArgs,
MaybeResult),
(
MaybeResult = yes(proc_trailing_info(Result,
@@ -527,7 +524,7 @@ check_goals_for_trail_mods(SCC, VarTypes, Goals,
Results, MaybeAnalysisStatuses, !ModuleInfo),
list.foldl(combine_trailing_status, Results, trail_will_not_modify,
Result),
list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
list.foldl(combine_maybe_trail_analysis_status, MaybeAnalysisStatuses,
yes(optimal), MaybeAnalysisStatus).
%----------------------------------------------------------------------------%
@@ -570,31 +567,31 @@ scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, InnerStatus) =
% Returns the trailing status corresponding to that procedure.
% Fails if there was no corresponding entry in the table.
%
:- pred pred_info_has_known_status(pred_info::in, trailing_status::out)
:- pred pred_info_has_known_trail_status(pred_info::in, trailing_status::out)
is semidet.
pred_info_has_known_status(PredInfo, Status) :-
pred_info_has_known_trail_status(PredInfo, Status) :-
Name = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
ModuleName = pred_info_module(PredInfo),
ModuleName = unqualified(ModuleNameStr),
Arity = pred_info_orig_arity(PredInfo),
known_procedure(PredOrFunc, ModuleNameStr, Name, Arity, Status).
trail_known_procedure(PredOrFunc, ModuleNameStr, Name, Arity, Status).
% known_procedure/4 is a table of library predicates whose trailing
% status is hardcoded into the analyser. For a few predicates this
% information can make a big difference (particularly in the absence
% of any form of intermodule analysis).
%
:- pred known_procedure(pred_or_func::in, string::in, string::in, int::in,
trailing_status::out) is semidet.
:- pred trail_known_procedure(pred_or_func::in, string::in,
string::in, int::in, trailing_status::out) is semidet.
known_procedure(pf_predicate, "require", "error", 1,
trail_known_procedure(pf_predicate, "require", "error", 1,
trail_will_not_modify).
known_procedure(pf_function, "require", "func_error", 1,
trail_known_procedure(pf_function, "require", "func_error", 1,
trail_will_not_modify).
known_procedure(_, "exception", "throw", 1, trail_will_not_modify).
known_procedure(_, "exception", "rethrow", 1, trail_will_not_modify).
trail_known_procedure(_, "exception", "throw", 1, trail_will_not_modify).
trail_known_procedure(_, "exception", "rethrow", 1, trail_will_not_modify).
%----------------------------------------------------------------------------%
%
@@ -610,16 +607,17 @@ known_procedure(_, "exception", "rethrow", 1, trail_will_not_modify).
% moment because the construction of the dependency graph doesn't
% take higher-order calls into account.
%
:- pred get_conditional_closures(module_info::in, set(pred_proc_id)::in,
:- pred trail_get_conditional_closures(module_info::in, set(pred_proc_id)::in,
list(pred_proc_id)::out) is semidet.
get_conditional_closures(ModuleInfo, Closures, Conditionals) :-
set.fold(get_conditional_closure(ModuleInfo), Closures, [], Conditionals).
trail_get_conditional_closures(ModuleInfo, Closures, Conditionals) :-
set.fold(trail_get_conditional_closure(ModuleInfo), Closures,
[], Conditionals).
:- pred get_conditional_closure(module_info::in, pred_proc_id::in,
:- pred trail_get_conditional_closure(module_info::in, pred_proc_id::in,
list(pred_proc_id)::in, list(pred_proc_id)::out) is semidet.
get_conditional_closure(ModuleInfo, PPId, !Conditionals) :-
trail_get_conditional_closure(ModuleInfo, PPId, !Conditionals) :-
module_info_pred_proc_info(ModuleInfo, PPId, _PredInfo, ProcInfo),
proc_info_get_trailing_info(ProcInfo, MaybeProcTrailingInfo),
MaybeProcTrailingInfo = yes(ProcTrailingInfo),
@@ -644,10 +642,10 @@ combine_trailing_status(trail_conditional, trail_conditional,
trail_conditional).
combine_trailing_status(trail_conditional, trail_may_modify, trail_may_modify).
:- pred combine_maybe_analysis_status(maybe(analysis_status)::in,
:- pred combine_maybe_trail_analysis_status(maybe(analysis_status)::in,
maybe(analysis_status)::in, maybe(analysis_status)::out) is det.
combine_maybe_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
combine_maybe_trail_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
( if
MaybeStatusA = yes(StatusA),
MaybeStatusB = yes(StatusB)
@@ -664,24 +662,24 @@ combine_maybe_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
% Check the trailing status of a call.
%
:- pred check_call(module_info::in, vartypes::in,
:- pred trail_check_call(module_info::in, vartypes::in,
pred_proc_id::in, prog_vars::in, trailing_status::out) is det.
check_call(ModuleInfo, VarTypes, PPId, Args, Result) :-
check_call_2(ModuleInfo, VarTypes, PPId, Args, MaybeResult),
trail_check_call(ModuleInfo, VarTypes, PPId, Args, Result) :-
trail_check_call_2(ModuleInfo, VarTypes, PPId, Args, MaybeResult),
(
MaybeResult = yes(proc_trailing_info(Result, _))
;
MaybeResult = no,
% If we do not have any information about the callee procedure then
% assume that it modifies the trail.
% If we do not have any information about the callee procedure,
% then we have to assume that it may modify the trail.
Result = trail_may_modify
).
:- pred check_call_2(module_info::in, vartypes::in,
:- pred trail_check_call_2(module_info::in, vartypes::in,
pred_proc_id::in, prog_vars::in, maybe(proc_trailing_info)::out) is det.
check_call_2(ModuleInfo, VarTypes, PPId, Args, MaybeResult) :-
trail_check_call_2(ModuleInfo, VarTypes, PPId, Args, MaybeResult) :-
module_info_pred_proc_info(ModuleInfo, PPId, _PredInfo, ProcInfo),
proc_info_get_trailing_info(ProcInfo, MaybeCalleeTrailingInfo),
(
@@ -702,18 +700,18 @@ check_call_2(ModuleInfo, VarTypes, PPId, Args, MaybeResult) :-
% XXX Need to handle higher-order args here as well.
MaybeResult = yes(proc_trailing_info(TrailingStatus,
AnalysisStatus)),
TrailingStatus = check_vars(ModuleInfo, VarTypes, Args)
TrailingStatus = trail_check_vars(ModuleInfo, VarTypes, Args)
)
;
MaybeCalleeTrailingInfo = no,
MaybeResult = no
).
:- func check_vars(module_info, vartypes, prog_vars) = trailing_status.
:- func trail_check_vars(module_info, vartypes, prog_vars) = trailing_status.
check_vars(ModuleInfo, VarTypes, Vars) = Result :-
trail_check_vars(ModuleInfo, VarTypes, Vars) = Result :-
lookup_var_types(VarTypes, Vars, Types),
Result = check_types(ModuleInfo, Types).
Result = trail_check_types(ModuleInfo, Types).
%----------------------------------------------------------------------------%
%
@@ -747,22 +745,23 @@ check_vars(ModuleInfo, VarTypes, Vars) = Result :-
% Return the collective trailing status of a list of types.
%
:- func check_types(module_info, list(mer_type)) = trailing_status.
:- func trail_check_types(module_info, list(mer_type)) = trailing_status.
check_types(ModuleInfo, Types) = Status :-
list.foldl(check_type(ModuleInfo), Types, trail_will_not_modify, Status).
trail_check_types(ModuleInfo, Types) = Status :-
list.foldl(trail_check_type(ModuleInfo), Types,
trail_will_not_modify, Status).
:- pred check_type(module_info::in, mer_type::in, trailing_status::in,
:- pred trail_check_type(module_info::in, mer_type::in, trailing_status::in,
trailing_status::out) is det.
check_type(ModuleInfo, Type, !Status) :-
combine_trailing_status(check_type(ModuleInfo, Type), !Status).
trail_check_type(ModuleInfo, Type, !Status) :-
combine_trailing_status(trail_check_type(ModuleInfo, Type), !Status).
% Return the trailing status of an individual type.
%
:- func check_type(module_info, mer_type) = trailing_status.
:- func trail_check_type(module_info, mer_type) = trailing_status.
check_type(ModuleInfo, Type) = Status :-
trail_check_type(ModuleInfo, Type) = Status :-
( if
( type_is_solver_type(ModuleInfo, Type)
; type_is_existq_type(ModuleInfo, Type)
@@ -773,13 +772,13 @@ check_type(ModuleInfo, Type) = Status :-
Status = trail_may_modify
else
TypeCtorCategory = classify_type(ModuleInfo, Type),
Status = check_type_2(ModuleInfo, Type, TypeCtorCategory)
Status = trail_check_type_2(ModuleInfo, Type, TypeCtorCategory)
).
:- func check_type_2(module_info, mer_type, type_ctor_category)
:- func trail_check_type_2(module_info, mer_type, type_ctor_category)
= trailing_status.
check_type_2(ModuleInfo, Type, TypeCtorCat) = Status :-
trail_check_type_2(ModuleInfo, Type, TypeCtorCat) = Status :-
(
( TypeCtorCat = ctor_cat_builtin(_)
; TypeCtorCat = ctor_cat_higher_order
@@ -808,7 +807,7 @@ check_type_2(ModuleInfo, Type, TypeCtorCat) = Status :-
% termination analysis as well, so we'll wait until that is done.
Status = trail_may_modify
else
Status = check_types(ModuleInfo, Args)
Status = trail_check_types(ModuleInfo, Args)
)
).
@@ -821,25 +820,25 @@ check_type_2(ModuleInfo, Type, TypeCtorCat) = Status :-
% features to the goal_infos of those procedure that cannot modify the
% trail.
%
:- pred annotate_proc(pred_proc_id::in, module_info::in, module_info::out)
is det.
:- pred trail_annotate_proc(pred_proc_id::in,
module_info::in, module_info::out) is det.
annotate_proc(PPId, !ModuleInfo) :-
trail_annotate_proc(PPId, !ModuleInfo) :-
some [!ProcInfo, !Body] (
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, !:ProcInfo),
proc_info_get_goal(!.ProcInfo, !:Body),
proc_info_get_vartypes(!.ProcInfo, VarTypes),
annotate_goal(VarTypes, !Body, _Status, !ModuleInfo),
trail_annotate_goal(VarTypes, !Body, _Status, !ModuleInfo),
proc_info_set_goal(!.Body, !ProcInfo),
module_info_set_pred_proc_info(PPId, PredInfo, !.ProcInfo, !ModuleInfo)
).
:- pred annotate_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
:- pred trail_annotate_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
trailing_status::out, module_info::in, module_info::out) is det.
annotate_goal(VarTypes, !Goal, Status, !ModuleInfo) :-
trail_annotate_goal(VarTypes, !Goal, Status, !ModuleInfo) :-
!.Goal = hlds_goal(GoalExpr0, GoalInfo0),
annotate_goal_2(VarTypes, GoalInfo0, GoalExpr0, GoalExpr, Status,
trail_annotate_goal_2(VarTypes, GoalInfo0, GoalExpr0, GoalExpr, Status,
!ModuleInfo),
(
Status = trail_will_not_modify,
@@ -853,11 +852,11 @@ annotate_goal(VarTypes, !Goal, Status, !ModuleInfo) :-
),
!:Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred annotate_goal_2(vartypes::in, hlds_goal_info::in,
:- pred trail_annotate_goal_2(vartypes::in, hlds_goal_info::in,
hlds_goal_expr::in, hlds_goal_expr::out, trailing_status::out,
module_info::in, module_info::out) is det.
annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
trail_annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
(
!.GoalExpr = unify(_, _, _, Kind, _),
(
@@ -894,7 +893,7 @@ annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
else if
% Handle library predicates whose trailing status
% can be looked up in the known procedure table.
pred_info_has_known_status(CallPredInfo, Status0)
pred_info_has_known_trail_status(CallPredInfo, Status0)
then
Status = Status0
else
@@ -905,7 +904,7 @@ annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
IntermodAnalysis = yes,
pred_info_is_imported(CallPredInfo)
then
search_analysis_status(CallPPId, Result, AnalysisStatus,
search_trail_analysis_status(CallPPId, Result, AnalysisStatus,
!ModuleInfo),
% XXX We shouldn't be getting invalid analysis results at this
@@ -919,7 +918,8 @@ annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
),
(
Result = trail_conditional,
Status = check_vars(!.ModuleInfo, VarTypes, CallArgs)
Status = trail_check_vars(!.ModuleInfo, VarTypes,
CallArgs)
;
( Result = trail_may_modify
; Result = trail_will_not_modify
@@ -929,7 +929,8 @@ annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
)
else
% This time around we will be checking recursive calls as well.
check_call(!.ModuleInfo, VarTypes, CallPPId, CallArgs, Status)
trail_check_call(!.ModuleInfo, VarTypes, CallPPId, CallArgs,
Status)
)
)
;
@@ -953,23 +954,23 @@ annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
)
;
!.GoalExpr = conj(ConjType, Conjuncts0),
annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status,
trail_annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status,
!ModuleInfo),
!:GoalExpr = conj(ConjType, Conjuncts)
;
!.GoalExpr = disj(Disjuncts0),
annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
trail_annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
!ModuleInfo),
!:GoalExpr = disj(Disjuncts)
;
!.GoalExpr = switch(Var, CanFail, Cases0),
annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo),
trail_annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo),
!:GoalExpr = switch(Var, CanFail, Cases)
;
!.GoalExpr = if_then_else(Vars, If0, Then0, Else0),
annotate_goal(VarTypes, If0, If, IfStatus, !ModuleInfo),
annotate_goal(VarTypes, Then0, Then, ThenStatus, !ModuleInfo),
annotate_goal(VarTypes, Else0, Else, ElseStatus, !ModuleInfo),
trail_annotate_goal(VarTypes, If0, If, IfStatus, !ModuleInfo),
trail_annotate_goal(VarTypes, Then0, Then, ThenStatus, !ModuleInfo),
trail_annotate_goal(VarTypes, Else0, Else, ElseStatus, !ModuleInfo),
( if
IfStatus = trail_will_not_modify,
ThenStatus = trail_will_not_modify,
@@ -982,7 +983,7 @@ annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
!:GoalExpr = if_then_else(Vars, If, Then, Else)
;
!.GoalExpr = negation(SubGoal0),
annotate_goal(VarTypes, SubGoal0, SubGoal, Status, !ModuleInfo),
trail_annotate_goal(VarTypes, SubGoal0, SubGoal, Status, !ModuleInfo),
!:GoalExpr = negation(SubGoal)
;
!.GoalExpr = scope(Reason, InnerGoal0),
@@ -990,7 +991,7 @@ annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
Status = trail_will_not_modify
else
OuterGoalInfo = GoalInfo,
annotate_goal(VarTypes, InnerGoal0, InnerGoal, Status0,
trail_annotate_goal(VarTypes, InnerGoal0, InnerGoal, Status0,
!ModuleInfo),
InnerGoal = hlds_goal(_, InnerGoalInfo),
InnerCodeModel = goal_info_get_code_model(InnerGoalInfo),
@@ -1004,29 +1005,31 @@ annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
unexpected($module, $pred, "shorthand")
).
:- pred annotate_goal_list(vartypes::in, hlds_goals::in,
hlds_goals::out, trailing_status::out, module_info::in,
module_info::out) is det.
:- pred trail_annotate_goal_list(vartypes::in,
list(hlds_goal)::in, list(hlds_goal)::out, trailing_status::out,
module_info::in, module_info::out) is det.
annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo) :-
list.map2_foldl(annotate_goal(VarTypes), !Goals, Statuses, !ModuleInfo),
trail_annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo) :-
list.map2_foldl(trail_annotate_goal(VarTypes), !Goals, Statuses,
!ModuleInfo),
list.foldl(combine_trailing_status, Statuses, trail_will_not_modify,
Status).
:- pred annotate_cases(vartypes::in, list(case)::in, list(case)::out,
:- pred trail_annotate_cases(vartypes::in, list(case)::in, list(case)::out,
trailing_status::out, module_info::in, module_info::out) is det.
annotate_cases(VarTypes, !Cases, Status, !ModuleInfo) :-
list.map2_foldl(annotate_case(VarTypes), !Cases, Statuses, !ModuleInfo),
trail_annotate_cases(VarTypes, !Cases, Status, !ModuleInfo) :-
list.map2_foldl(trail_annotate_case(VarTypes), !Cases, Statuses,
!ModuleInfo),
list.foldl(combine_trailing_status, Statuses, trail_will_not_modify,
Status).
:- pred annotate_case(vartypes::in, case::in, case::out,
:- pred trail_annotate_case(vartypes::in, case::in, case::out,
trailing_status::out, module_info::in, module_info::out) is det.
annotate_case(VarTypes, !Case, Status, !ModuleInfo) :-
trail_annotate_case(VarTypes, !Case, Status, !ModuleInfo) :-
!.Case = case(MainConsId, OtherConsIds, Goal0),
annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo),
trail_annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo),
!:Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
@@ -1037,12 +1040,12 @@ annotate_case(VarTypes, !Case, Status, !ModuleInfo) :-
:- type trailing_analysis_answer
---> trailing_analysis_answer(trailing_status).
:- func analysis_name = string.
:- func trail_analysis_name = string.
analysis_name = "trail_usage".
trail_analysis_name = "trail_usage".
:- instance analysis(no_func_info, any_call, trailing_analysis_answer) where [
analysis_name(_, _) = analysis_name,
analysis_name(_, _) = trail_analysis_name,
analysis_version_number(_, _) = 1,
preferred_fixpoint_type(_, _) = least_fixpoint,
bottom(_, _) = trailing_analysis_answer(trail_will_not_modify),
@@ -1093,20 +1096,20 @@ trailing_status_to_string(trail_may_modify, "may_modify_trail").
trailing_status_to_string(trail_will_not_modify, "will_not_modify_trail").
trailing_status_to_string(trail_conditional, "conditional").
:- pred search_analysis_status(pred_proc_id::in, trailing_status::out,
:- pred search_trail_analysis_status(pred_proc_id::in, trailing_status::out,
analysis_status::out, module_info::in, module_info::out) is det.
search_analysis_status(PPId, Result, AnalysisStatus, !ModuleInfo) :-
search_trail_analysis_status(PPId, Result, AnalysisStatus, !ModuleInfo) :-
module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
search_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
search_trail_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
AnalysisInfo0, AnalysisInfo),
module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
:- pred search_analysis_status_2(module_info::in, pred_proc_id::in,
:- pred search_trail_analysis_status_2(module_info::in, pred_proc_id::in,
trailing_status::out, analysis_status::out,
analysis_info::in, analysis_info::out) is det.
search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
search_trail_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
!AnalysisInfo) :-
mmc_analysis.module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
Call = any_call,
@@ -1124,7 +1127,8 @@ search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus,
top(no_func_info, Call) = Answer,
Answer = trailing_analysis_answer(Result),
AnalysisStatus = optimal,
record_request(analysis_name, ModuleName, FuncId, Call, !AnalysisInfo)
record_request(trail_analysis_name, ModuleName, FuncId, Call,
!AnalysisInfo)
).
:- pred maybe_record_trailing_result(module_info::in, pred_id::in,