mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-18 07:15:19 +00:00
5f589e98fb
Estimated hours taken: 4 Branches: main Various cleanups for the modules in the compiler directory. The are no changes to algorithms except the replacement of some if-then-elses that would naturally be switches with switches and the replacement of most of the calls to error/1. compiler/*.m: Convert calls to error/1 to calls to unexpected/2 or sorry/2 as appropriate throughout most or the compiler. Fix inaccurate assertion failure messages, e.g. identifying the assertion failure as taking place in the wrong module. Add :- end_module declarations. Fix formatting problems and bring the positioning of comments into line with our current coding standards. Fix some overlong lines. Convert some more modules to 4-space indentation. Fix some spots where previous conversions to 4-space indentation have stuffed the formatting of the code up. Fix a bunch of typos in comments. Use state variables in more places; use library predicates from the sv* modules where appropriate. Delete unnecessary and duplicate module imports. Misc. other small cleanups.
803 lines
31 KiB
Mathematica
803 lines
31 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2004-2005 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% File: exception_analysis.m.
|
|
% Author: juliensf.
|
|
|
|
% This module performs an exception tracing analysis. The aim is to annotate
|
|
% the HLDS with information about whether each procedure might or will not
|
|
% throw an exception.
|
|
%
|
|
% This information can be useful to the compiler when applying certain types
|
|
% of optimization.
|
|
%
|
|
% After running the analysis the exception behaviour of each procedure
|
|
% is one of:
|
|
%
|
|
% (1) will_not_throw_exception
|
|
% (2) may_throw_an_exception
|
|
% (3) conditional
|
|
%
|
|
% (1) guarantees that, for all inputs, the procedure will not throw an
|
|
% exception.
|
|
%
|
|
% (2) means that a call to that procedure might result in an exception
|
|
% being thrown for at least some inputs.
|
|
%
|
|
% We distinguish between two kinds of exception. Those that
|
|
% are ultimately a result of a call to exception.throw/1, which
|
|
% we refer to as "user exceptions" and those that result from a
|
|
% unification or comparison where one of the types involved has
|
|
% a user-defined equality/comparison predicate that throws
|
|
% an exception. We refer to the latter kind, as "type exceptions".
|
|
%
|
|
% This means that for some polymorphic procedures we cannot
|
|
% say what will happen until we know the values of the type variables.
|
|
% And so we have ...
|
|
%
|
|
% (3) means that the exception status of the procedure is dependent upon the
|
|
% values of some higher-order variables, or the values of some type
|
|
% variables or both. This means that we cannot say anything definite
|
|
% about the procedure but for calls to the procedure where have the
|
|
% necessary information we can say what will happen.
|
|
%
|
|
% In the event that we cannot determine the exception status we just assume
|
|
% the worst and mark the procedure as maybe throwing a user exception.
|
|
%
|
|
% For procedures that are defined using the FFI we currently assume that if a
|
|
% procedure will not make calls back to Mercury then it cannot throw
|
|
% a Mercury exception; if it does make calls to Mercury then it might
|
|
% throw an exception.
|
|
%
|
|
% NOTE: Some backends, e.g the Java backend, use exceptions in the target
|
|
% language for various things but we're not interested in that here.
|
|
%
|
|
% TODO:
|
|
% - higher order stuff
|
|
% - use intermodule-analysis framework
|
|
% - check what user-defined equality and comparison preds
|
|
% actually do rather than assuming that they always
|
|
% may throw exceptions.
|
|
% - handle existential and solver types - currently we just
|
|
% assume that any call to unify or compare for these types
|
|
% might result in an exception being thrown.
|
|
%
|
|
% XXX We need to be a bit careful with transformations like tabling that
|
|
% might add calls to exception.throw - at the moment this isn't a problem
|
|
% because exception analysis takes place after the tabling transformation.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.exception_analysis.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
|
|
:- import_module io.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
% Perform the exception analysis on a module.
|
|
%
|
|
:- pred exception_analysis.process_module(module_info::in, module_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% Write out the exception pragmas for this module.
|
|
%
|
|
:- pred exception_analysis.write_pragma_exceptions(module_info::in,
|
|
exception_info::in, pred_id::in, io::di, io::uo) is det.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.make_hlds.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module hlds.special_pred.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.mercury_to_mercury.
|
|
:- import_module parse_tree.modules.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_util.
|
|
:- import_module transform_hlds.dependency_graph.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module set.
|
|
:- import_module std_util.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Perform exception analysis on a module
|
|
%
|
|
|
|
exception_analysis.process_module(!ModuleInfo, !IO) :-
|
|
module_info_ensure_dependency_info(!ModuleInfo),
|
|
module_info_dependency_info(!.ModuleInfo, DepInfo),
|
|
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
|
|
list.foldl(process_scc, SCCs, !ModuleInfo),
|
|
globals.io_lookup_bool_option(make_optimization_interface,
|
|
MakeOptInt, !IO),
|
|
( if MakeOptInt = yes
|
|
then exception_analysis.make_opt_int(!.ModuleInfo, !IO)
|
|
else true
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Perform exception 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 :: exception_status,
|
|
% Exception status of this procedure
|
|
% not counting any input from
|
|
% (mutually-)recursive inputs.
|
|
rec_calls :: type_status
|
|
% The collective type status of the
|
|
% types of the terms that are arguments
|
|
% of (mutually-)recursive calls.
|
|
).
|
|
|
|
:- pred process_scc(scc::in, module_info::in, module_info::out) is det.
|
|
|
|
process_scc(SCC, !ModuleInfo) :-
|
|
ProcResults = check_procs_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.
|
|
%
|
|
Status = combine_individual_proc_results(ProcResults),
|
|
%
|
|
% Update the exception info. with information about this SCC.
|
|
%
|
|
module_info_get_exception_info(!.ModuleInfo, ExceptionInfo0),
|
|
Update = (pred(PPId::in, Info0::in, Info::out) is det :-
|
|
Info = Info0 ^ elem(PPId) := Status
|
|
),
|
|
list.foldl(Update, SCC, ExceptionInfo0, ExceptionInfo),
|
|
module_info_set_exception_info(ExceptionInfo, !ModuleInfo).
|
|
|
|
% Check each procedure in the SCC individually.
|
|
%
|
|
:- func check_procs_for_exceptions(scc, module_info) = proc_results.
|
|
|
|
check_procs_for_exceptions(SCC, ModuleInfo) = Result :-
|
|
list.foldl(check_proc_for_exceptions(SCC, ModuleInfo), SCC, [], Result).
|
|
|
|
% Examine how the procedures interact with other procedures that
|
|
% are mutually-recursive to them.
|
|
%
|
|
:- func combine_individual_proc_results(proc_results) = exception_status.
|
|
|
|
combine_individual_proc_results([]) = _ :-
|
|
unexpected(this_file, "Empty SCC during exception analysis.").
|
|
combine_individual_proc_results(ProcResults @ [_|_]) = SCC_Result :-
|
|
(
|
|
% If none of the procedures may throw an exception or
|
|
% are conditional then the SCC cannot throw an exception
|
|
% either.
|
|
all [ProcResult] list.member(ProcResult, ProcResults) =>
|
|
ProcResult ^ status = will_not_throw
|
|
->
|
|
SCC_Result = will_not_throw
|
|
;
|
|
% If none of the procedures may throw an exception but
|
|
% at least one of them is conditional then somewhere in
|
|
% the SCC there is a call to unify or compare that may
|
|
% rely on the types of the polymorphically typed
|
|
% arguments.
|
|
%
|
|
% We need to check that any recursive calls
|
|
% do not introduce types that might have user-defined
|
|
% equality or comparison predicate that throw
|
|
% exceptions.
|
|
all [EResult] list.member(EResult, ProcResults) =>
|
|
EResult ^ status \= may_throw(_),
|
|
some [CResult] (
|
|
list.member(CResult, ProcResults),
|
|
CResult ^ status = conditional
|
|
)
|
|
->
|
|
SCC_Result = handle_mixed_conditional_scc(ProcResults)
|
|
;
|
|
% If none of the procedures can throw a user_exception
|
|
% but one or more can throw a type_exception then mark
|
|
% the SCC as maybe throwing a type_exception.
|
|
all [EResult] list.member(EResult, ProcResults) =>
|
|
EResult ^ status \= may_throw(user_exception),
|
|
some [TResult] (
|
|
list.member(TResult, ProcResults),
|
|
TResult ^ status = may_throw(type_exception)
|
|
)
|
|
->
|
|
SCC_Result = may_throw(type_exception)
|
|
;
|
|
SCC_Result = may_throw(user_exception)
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Process individual procedures
|
|
%
|
|
|
|
:- pred check_proc_for_exceptions(scc::in, module_info::in,
|
|
pred_proc_id::in, proc_results::in, proc_results::out) is det.
|
|
|
|
check_proc_for_exceptions(SCC, ModuleInfo, PPId, !Results) :-
|
|
module_info_pred_proc_info(ModuleInfo, PPId, _, ProcInfo),
|
|
proc_info_goal(ProcInfo, Body),
|
|
proc_info_vartypes(ProcInfo, VarTypes),
|
|
Result0 = proc_result(PPId, will_not_throw, type_will_not_throw),
|
|
check_goal_for_exceptions(SCC, ModuleInfo, VarTypes, Body, Result0,
|
|
Result),
|
|
list.cons(Result, !Results).
|
|
|
|
:- pred check_goal_for_exceptions(scc::in, module_info::in, vartypes::in,
|
|
hlds_goal::in, proc_result::in, proc_result::out) is det.
|
|
|
|
check_goal_for_exceptions(SCC, ModuleInfo, VarTypes, Goal - GoalInfo,
|
|
!Result) :-
|
|
( goal_info_get_determinism(GoalInfo, erroneous) ->
|
|
!:Result = !.Result ^ status := may_throw(user_exception)
|
|
;
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, Goal, GoalInfo,
|
|
!Result)
|
|
).
|
|
|
|
:- pred check_goal_for_exceptions_2(scc::in, module_info::in, vartypes::in,
|
|
hlds_goal_expr::in, hlds_goal_info::in, proc_result::in, proc_result::out)
|
|
is det.
|
|
|
|
check_goal_for_exceptions_2(_, _, _, Goal, _, !Result) :-
|
|
Goal = unify(_, _, _, Kind, _),
|
|
( Kind = complicated_unify(_, _, _) ->
|
|
unexpected(this_file,
|
|
"complicated unify during exception analysis.")
|
|
;
|
|
true
|
|
).
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, Goal, _, !Result) :-
|
|
Goal = call(CallPredId, CallProcId, CallArgs, _, _, _),
|
|
CallPPId = proc(CallPredId, CallProcId),
|
|
module_info_pred_info(ModuleInfo, CallPredId, CallPredInfo),
|
|
(
|
|
% Handle (mutually-)recursive calls.
|
|
list.member(CallPPId, SCC)
|
|
->
|
|
Types = list.map((func(Var) = VarTypes ^ det_elem(Var)),
|
|
CallArgs),
|
|
TypeStatus = check_types(ModuleInfo, Types),
|
|
combine_type_status(TypeStatus, !.Result ^ rec_calls,
|
|
NewTypeStatus),
|
|
!:Result = !.Result ^ rec_calls := NewTypeStatus
|
|
;
|
|
pred_info_is_builtin(CallPredInfo)
|
|
->
|
|
% Builtins won't throw exceptions.
|
|
true
|
|
;
|
|
% Handle unify and compare.
|
|
(
|
|
ModuleName = pred_info_module(CallPredInfo),
|
|
any_mercury_builtin_module(ModuleName),
|
|
Name = pred_info_name(CallPredInfo),
|
|
Arity = pred_info_orig_arity(CallPredInfo),
|
|
( SpecialPredId = spec_pred_compare
|
|
; SpecialPredId = spec_pred_unify
|
|
),
|
|
special_pred_name_arity(SpecialPredId, Name, _, Arity)
|
|
;
|
|
pred_info_get_origin(CallPredInfo, Origin),
|
|
Origin = special_pred(SpecialPredId - _),
|
|
( SpecialPredId = spec_pred_compare
|
|
; SpecialPredId = spec_pred_unify
|
|
)
|
|
)
|
|
->
|
|
% For unification/comparison the exception status depends
|
|
% upon the the types of the arguments. In particular
|
|
% whether some component of that type has a user-defined
|
|
% equality/comparison predicate that throws an exception.
|
|
check_vars(ModuleInfo, VarTypes, CallArgs, !Result)
|
|
;
|
|
check_nonrecursive_call(ModuleInfo, VarTypes, CallPPId, CallArgs,
|
|
!Result)
|
|
).
|
|
check_goal_for_exceptions_2(_, ModuleInfo, VarTypes, Goal, GoalInfo,
|
|
!Result) :-
|
|
Goal = generic_call(Details, Args, _ArgModes, _),
|
|
(
|
|
Details = higher_order(Var, _, _, _),
|
|
ClosureValueMap = goal_info_get_ho_values(GoalInfo),
|
|
( ClosureValues = ClosureValueMap ^ elem(Var) ->
|
|
(
|
|
get_conditional_closures(ModuleInfo, ClosureValues,
|
|
Conditional)
|
|
->
|
|
(
|
|
Conditional = []
|
|
% The possible values of the higher-order variable
|
|
% are all procedures that are known not to throw
|
|
% exceptions.
|
|
;
|
|
Conditional = [_|_],
|
|
%
|
|
% For 'conditional' procedures we need to make
|
|
% sure that if any type variables are bound at
|
|
% the generic_call site, then this does not
|
|
% cause the closure to throw an exception
|
|
% (because of a user-defined equality or
|
|
% comparison predicate that throws an
|
|
% exception.)
|
|
%
|
|
% If we can resolve all of the polymorphism at
|
|
% this generic_call site, then we can reach a
|
|
% definite conclusion about it.
|
|
%
|
|
% If we cannot do so, then we propagate the
|
|
% 'conditional' status to the current predicate
|
|
% if all the type variables involved are
|
|
% universally quantified, or mark it as throwing
|
|
% an exception if some of them are existentially
|
|
% quantified.
|
|
%
|
|
% XXX This is too conservative but we don't
|
|
% currently perform a fine-grained enough
|
|
% analysis of where out-of-line
|
|
% unifications/comparisons occur to be able to
|
|
% do better.
|
|
%
|
|
check_vars(ModuleInfo, VarTypes, Args, !Result)
|
|
)
|
|
;
|
|
!:Result = !.Result ^ status := may_throw(user_exception)
|
|
)
|
|
;
|
|
!:Result = !.Result ^ status := may_throw(user_exception)
|
|
)
|
|
;
|
|
% XXX We could do better with class methods.
|
|
Details = class_method(_, _, _, _),
|
|
!:Result = !.Result ^ status := may_throw(user_exception)
|
|
;
|
|
Details = cast(_)
|
|
;
|
|
Details = aditi_builtin(_, _),
|
|
!:Result = !.Result ^ status := may_throw(user_exception)
|
|
).
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, not(Goal), _,
|
|
!Result) :-
|
|
check_goal_for_exceptions(SCC, ModuleInfo, VarTypes, Goal, !Result).
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, Goal, _,
|
|
!Result) :-
|
|
Goal = scope(_, ScopeGoal),
|
|
check_goal_for_exceptions(SCC, ModuleInfo, VarTypes, ScopeGoal, !Result).
|
|
check_goal_for_exceptions_2(_, _, _, Goal, _, !Result) :-
|
|
Goal = foreign_proc(Attributes, _, _, _, _, _),
|
|
( may_call_mercury(Attributes) = may_call_mercury ->
|
|
may_throw_exception(Attributes) = MayThrowException,
|
|
%
|
|
% We do not need to deal with erroneous predicates
|
|
% here because they will have already been processed.
|
|
%
|
|
( MayThrowException = default_exception_behaviour ->
|
|
!:Result = !.Result ^ status := may_throw(user_exception)
|
|
;
|
|
true
|
|
)
|
|
;
|
|
true
|
|
).
|
|
check_goal_for_exceptions_2(_, _, _, shorthand(_), _, _, _) :-
|
|
unexpected(this_file,
|
|
"shorthand goal encountered during exception analysis.").
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, Goal, _, !Result) :-
|
|
Goal = switch(_, _, Cases),
|
|
CaseGoals = list.map((func(case(_, CaseGoal)) = CaseGoal), Cases),
|
|
check_goals_for_exceptions(SCC, ModuleInfo, VarTypes, CaseGoals, !Result).
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, Goal, _, !Result) :-
|
|
Goal = if_then_else(_, If, Then, Else),
|
|
check_goals_for_exceptions(SCC, ModuleInfo, VarTypes, [If, Then, Else],
|
|
!Result).
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, disj(Goals), _,
|
|
!Result) :-
|
|
check_goals_for_exceptions(SCC, ModuleInfo, VarTypes, Goals, !Result).
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, par_conj(Goals), _,
|
|
!Result) :-
|
|
check_goals_for_exceptions(SCC, ModuleInfo, VarTypes, Goals, !Result).
|
|
check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, conj(Goals), _,
|
|
!Result) :-
|
|
check_goals_for_exceptions(SCC, ModuleInfo, VarTypes, Goals, !Result).
|
|
|
|
:- pred check_goals_for_exceptions(scc::in, module_info::in, vartypes::in,
|
|
hlds_goals::in, proc_result::in, proc_result::out) is det.
|
|
|
|
check_goals_for_exceptions(_, _, _, [], !Result).
|
|
check_goals_for_exceptions(SCC, ModuleInfo, VarTypes, [ Goal | Goals ],
|
|
!Result) :-
|
|
check_goal_for_exceptions(SCC, ModuleInfo, VarTypes, Goal, !Result),
|
|
%
|
|
% We can stop searching if we find a user exception. However if we
|
|
% find a type exception then we still need to check that there is
|
|
% not a user exception somewhere in the rest of the SCC.
|
|
%
|
|
( if !.Result ^ status = may_throw(user_exception)
|
|
then true
|
|
else check_goals_for_exceptions(SCC, ModuleInfo, VarTypes, Goals,
|
|
!Result)
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Further code to handle higher-order variables
|
|
%
|
|
|
|
% Given a list of procedure ids extract those whose exception status
|
|
% has been set to 'conditional'. Fails if one of the procedures in
|
|
% the set has an exception status that indicates it may throw an
|
|
% exception, or if the exception status for a procedure has not yet
|
|
% been set.
|
|
%
|
|
:- pred get_conditional_closures(module_info::in, set(pred_proc_id)::in,
|
|
list(pred_proc_id)::out) is semidet.
|
|
|
|
get_conditional_closures(ModuleInfo, Closures, Conditionals) :-
|
|
module_info_get_exception_info(ModuleInfo, ExceptionInfo),
|
|
set.fold(get_conditional_closure(ExceptionInfo), Closures,
|
|
[], Conditionals).
|
|
|
|
:- pred get_conditional_closure(exception_info::in, pred_proc_id::in,
|
|
list(pred_proc_id)::in, list(pred_proc_id)::out) is semidet.
|
|
|
|
get_conditional_closure(ExceptionInfo, PPId, !Conditionals) :-
|
|
ExceptionInfo ^ elem(PPId) = Status,
|
|
(
|
|
Status = conditional,
|
|
list.cons(PPId, !Conditionals)
|
|
;
|
|
Status = will_not_throw
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- pred update_proc_result(exception_status::in, proc_result::in,
|
|
proc_result::out) is det.
|
|
|
|
update_proc_result(CurrentStatus, !Result) :-
|
|
OldStatus = !.Result ^ status,
|
|
NewStatus = combine_exception_status(CurrentStatus, OldStatus),
|
|
!:Result = !.Result ^ status := NewStatus.
|
|
|
|
:- func combine_exception_status(exception_status, exception_status)
|
|
= exception_status.
|
|
|
|
combine_exception_status(will_not_throw, Y) = Y.
|
|
combine_exception_status(X @ may_throw(user_exception), _) = X.
|
|
combine_exception_status(X @ may_throw(type_exception), will_not_throw) = X.
|
|
combine_exception_status(X @ may_throw(type_exception), conditional) = X.
|
|
combine_exception_status(may_throw(type_exception), Y @ may_throw(_)) = Y.
|
|
combine_exception_status(conditional, conditional) = conditional.
|
|
combine_exception_status(conditional, will_not_throw) = conditional.
|
|
combine_exception_status(conditional, Y @ may_throw(_)) = Y.
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Extra procedures for handling calls.
|
|
%
|
|
|
|
:- pred check_nonrecursive_call(module_info::in, vartypes::in,
|
|
pred_proc_id::in, prog_vars::in, proc_result::in,
|
|
proc_result::out) is det.
|
|
|
|
check_nonrecursive_call(ModuleInfo, VarTypes, PPId, Args, !Result) :-
|
|
module_info_get_exception_info(ModuleInfo, ExceptionInfo),
|
|
( map.search(ExceptionInfo, PPId, CalleeExceptionStatus) ->
|
|
(
|
|
CalleeExceptionStatus = will_not_throw
|
|
;
|
|
CalleeExceptionStatus = may_throw(ExceptionType),
|
|
update_proc_result(may_throw(ExceptionType), !Result)
|
|
;
|
|
CalleeExceptionStatus = conditional,
|
|
check_vars(ModuleInfo, VarTypes, Args, !Result)
|
|
)
|
|
;
|
|
% If we do not have any information about the callee procedure
|
|
% then assume that it might throw an exception.
|
|
update_proc_result(may_throw(user_exception), !Result)
|
|
).
|
|
|
|
:- pred check_vars(module_info::in, vartypes::in, prog_vars::in,
|
|
proc_result::in, proc_result::out) is det.
|
|
|
|
check_vars(ModuleInfo, VarTypes, Vars, !Result) :-
|
|
Types = list.map((func(Var) = VarTypes ^ det_elem(Var)), Vars),
|
|
TypeStatus = check_types(ModuleInfo, Types),
|
|
(
|
|
TypeStatus = type_will_not_throw
|
|
;
|
|
TypeStatus = type_may_throw,
|
|
update_proc_result(may_throw(type_exception), !Result)
|
|
;
|
|
TypeStatus = type_conditional,
|
|
update_proc_result(conditional, !Result)
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% 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
|
|
% 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.
|
|
%
|
|
% We currently assume that if these types are introduced
|
|
% somewhere in the SCC then they may be propagated around the entire
|
|
% SCC - hence if a part of the SCC is conditional we need to make
|
|
% sure other parts don't supply it with input whose types may have
|
|
% user-defined equality/comparison predicates.
|
|
%
|
|
% 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.
|
|
|
|
handle_mixed_conditional_scc(Results) =
|
|
(
|
|
all [TypeStatus] list.member(Result, Results) =>
|
|
Result ^ rec_calls \= type_may_throw
|
|
->
|
|
conditional
|
|
;
|
|
% Somewhere a type that causes an exception is being
|
|
% passed around the SCC via one or more of the recursive
|
|
% calls.
|
|
may_throw(type_exception)
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff for processing types.
|
|
%
|
|
|
|
% This is used in the analysis of calls to polymorphic procedures.
|
|
%
|
|
% By saying a `type can throw an exception' we mean that an exception
|
|
% might be thrown as a result of a unification or comparison involving
|
|
% the type because it has a user-defined equality/comparison predicate
|
|
% that may throw an exception.
|
|
%
|
|
% XXX We don't actually need to examine all the types, just those
|
|
% that are potentially going to be involved in unification/comparisons.
|
|
% At the moment we don't keep track of that information so the current
|
|
% procedure is as follows:
|
|
%
|
|
% Examine the functor and then recursively examine the arguments.
|
|
% * If everything will not throw then the type will not throw
|
|
% * If at least one of the types may_throw then the type will throw
|
|
% * If at least one of the types is conditional and none of them throw then
|
|
% the type is conditional.
|
|
|
|
:- type type_status
|
|
---> type_will_not_throw
|
|
% This type does not have user-defined equality
|
|
% or comparison predicates.
|
|
% XXX (Or it has ones that are known not to throw
|
|
% exceptions).
|
|
|
|
; type_may_throw
|
|
% This type has a user-defined equality or comparison
|
|
% predicate that is known to throw an exception.
|
|
|
|
; type_conditional.
|
|
% This type is polymorphic. We cannot say anything about
|
|
% it until we know the values of the type-variables.
|
|
|
|
% Return the collective type status of a list of types.
|
|
%
|
|
:- func check_types(module_info, list(mer_type)) = type_status.
|
|
|
|
check_types(ModuleInfo, Types) = Status :-
|
|
list.foldl(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.
|
|
|
|
check_type(ModuleInfo, Type, !Status) :-
|
|
combine_type_status(check_type(ModuleInfo, Type), !Status).
|
|
|
|
:- pred combine_type_status(type_status::in, type_status::in,
|
|
type_status::out) is det.
|
|
|
|
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).
|
|
|
|
% Return the type status of an individual type.
|
|
%
|
|
:- func check_type(module_info, mer_type) = type_status.
|
|
|
|
check_type(ModuleInfo, Type) = Status :-
|
|
(
|
|
( type_util.is_solver_type(ModuleInfo, Type)
|
|
; type_util.is_existq_type(ModuleInfo, Type))
|
|
->
|
|
% XXX At the moment we just assume that existential
|
|
% types and solver types result in a type exception
|
|
% being thrown.
|
|
Status = type_may_throw
|
|
;
|
|
TypeCategory = type_util.classify_type(ModuleInfo, Type),
|
|
Status = check_type_2(ModuleInfo, Type, TypeCategory)
|
|
).
|
|
|
|
:- func check_type_2(module_info, mer_type, type_category) = type_status.
|
|
|
|
check_type_2(_, _, type_cat_int) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_char) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_string) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_float) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_higher_order) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_type_info) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_type_ctor_info) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_typeclass_info) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_base_typeclass_info) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_void) = type_will_not_throw.
|
|
check_type_2(_, _, type_cat_dummy) = type_will_not_throw.
|
|
|
|
check_type_2(_, _, type_cat_variable) = type_conditional.
|
|
|
|
check_type_2(ModuleInfo, Type, type_cat_tuple) =
|
|
check_user_type(ModuleInfo, Type).
|
|
check_type_2(ModuleInfo, Type, type_cat_enum) =
|
|
check_user_type(ModuleInfo, Type).
|
|
check_type_2(ModuleInfo, Type, type_cat_user_ctor) =
|
|
check_user_type(ModuleInfo, Type).
|
|
|
|
:- func check_user_type(module_info, mer_type) = type_status.
|
|
|
|
check_user_type(ModuleInfo, Type) = Status :-
|
|
( type_to_ctor_and_args(Type, _TypeCtor, Args) ->
|
|
(
|
|
type_has_user_defined_equality_pred(ModuleInfo, Type,
|
|
_UnifyCompare)
|
|
->
|
|
% XXX We can do better than this by examining what these preds
|
|
% actually do. Something similar needs to be sorted out for
|
|
% termination analysis as well, so we'll wait until that is done.
|
|
Status = type_may_throw
|
|
;
|
|
Status = check_types(ModuleInfo, Args)
|
|
)
|
|
|
|
;
|
|
unexpected(this_file, "Unable to get ctor and args.")
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff for intermodule optimization.
|
|
%
|
|
|
|
:- pred exception_analysis.make_opt_int(module_info::in, io::di, io::uo)
|
|
is det.
|
|
|
|
exception_analysis.make_opt_int(ModuleInfo, !IO) :-
|
|
module_info_get_name(ModuleInfo, ModuleName),
|
|
module_name_to_file_name(ModuleName, ".opt.tmp", no, OptFileName, !IO),
|
|
globals.io_lookup_bool_option(verbose, Verbose, !IO),
|
|
maybe_write_string(Verbose,
|
|
"% Appending exceptions pragmas to `", !IO),
|
|
maybe_write_string(Verbose, OptFileName, !IO),
|
|
maybe_write_string(Verbose, "'...", !IO),
|
|
maybe_flush_output(Verbose, !IO),
|
|
io.open_append(OptFileName, OptFileRes, !IO),
|
|
(
|
|
OptFileRes = ok(OptFile),
|
|
io.set_output_stream(OptFile, OldStream, !IO),
|
|
module_info_get_exception_info(ModuleInfo, ExceptionInfo),
|
|
module_info_predids(ModuleInfo, PredIds),
|
|
list.foldl(write_pragma_exceptions(ModuleInfo, ExceptionInfo),
|
|
PredIds, !IO),
|
|
io.set_output_stream(OldStream, _, !IO),
|
|
io.close_output(OptFile, !IO),
|
|
maybe_write_string(Verbose, " done.\n", !IO)
|
|
;
|
|
OptFileRes = error(IOError),
|
|
maybe_write_string(Verbose, " failed!\n", !IO),
|
|
io.error_message(IOError, IOErrorMessage),
|
|
io.write_strings(["Error opening file `",
|
|
OptFileName, "' for output: ", IOErrorMessage], !IO),
|
|
io.set_exit_status(1, !IO)
|
|
).
|
|
|
|
write_pragma_exceptions(ModuleInfo, ExceptionInfo, PredId, !IO) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_import_status(PredInfo, ImportStatus),
|
|
(
|
|
( ImportStatus = exported
|
|
; ImportStatus = opt_exported
|
|
),
|
|
not is_unify_or_compare_pred(PredInfo),
|
|
module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
|
|
TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
|
|
not set.member(PredId, TypeSpecForcePreds),
|
|
%
|
|
% XXX Writing out pragmas for the automatically
|
|
% generated class instance methods causes the
|
|
% compiler to abort when it reads them back in.
|
|
%
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
not check_marker(Markers, class_instance_method),
|
|
not check_marker(Markers, named_class_instance_method)
|
|
->
|
|
ModuleName = pred_info_module(PredInfo),
|
|
Name = pred_info_name(PredInfo),
|
|
Arity = pred_info_orig_arity(PredInfo),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
ProcIds = pred_info_procids(PredInfo),
|
|
%
|
|
% XXX The termination analyser outputs pragmas even if
|
|
% it doesn't have any information - should we be doing
|
|
% this?
|
|
%
|
|
list.foldl((pred(ProcId::in, !.IO::di, !:IO::uo) is det :-
|
|
proc_id_to_int(ProcId, ModeNum),
|
|
( map.search(ExceptionInfo, proc(PredId, ProcId), Status) ->
|
|
mercury_output_pragma_exceptions(PredOrFunc,
|
|
qualified(ModuleName, Name), Arity, ModeNum, Status, !IO)
|
|
;
|
|
true
|
|
)), ProcIds, !IO)
|
|
;
|
|
true
|
|
).
|
|
|
|
%----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "exception_analysis.m".
|
|
|
|
%----------------------------------------------------------------------------%
|
|
:- end_module exception_analysis.
|
|
%----------------------------------------------------------------------------%
|