%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 1997-1998, 2003-2008, 2010-2012 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: term_pass1.m. % Main author: crs. % Significant parts rewritten by zs. % % This file contains the first pass of the termination analysis, whose job is % to discover an upper bound on the difference between the sizes of the output % arguments of a procedure on the one hand and the sizes of a selected set of % input arguments of the procedure on the other hand. We refer to this % selected set of input arguments as the "output suppliers". % % For details, please refer to the papers mentioned in termination.m. % %-----------------------------------------------------------------------------% :- module transform_hlds.term_pass1. :- interface. :- import_module hlds. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module transform_hlds.term_errors. :- import_module transform_hlds.term_util. :- import_module list. :- import_module pair. %-----------------------------------------------------------------------------% :- type arg_size_result ---> arg_size_ok( % Gives the gamma of each procedure in the SCC. list(pair(pred_proc_id, int)), % Gives the output suppliers of each procedure in the SCC. used_args ) ; arg_size_error( list(term_error) ). :- pred find_arg_sizes_in_scc(module_info::in, pass_info::in, scc::in, arg_size_result::out, list(term_error)::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module hlds.goal_util. :- import_module hlds.hlds_goal. :- import_module libs. :- import_module libs.lp. :- import_module parse_tree. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_data_pragma. :- import_module parse_tree.var_table. :- import_module transform_hlds.term_traversal. :- import_module bag. :- import_module bool. :- import_module float. :- import_module map. :- import_module maybe. :- import_module require. :- import_module set. :- import_module term. :- import_module varset. %-----------------------------------------------------------------------------% :- type pass1_result ---> term_pass1_ok( % One entry for each path through the code. list(term_path_info), % The next output_supplier map. used_args, % There is an entry in this list for each procedure in the SCC % in which the set of active vars is not a subset of the % input arguments. list(term_error) ) ; term_pass1_error( list(term_error) ). find_arg_sizes_in_scc(ModuleInfo, PassInfo, SCC, ArgSize, TermErrors) :- set.to_sorted_list(SCC, SCCProcs), init_output_suppliers(ModuleInfo, SCCProcs, InitOutputSupplierMap), find_arg_sizes_in_scc_fixpoint(ModuleInfo, PassInfo, SCCProcs, InitOutputSupplierMap, Result, TermErrors), ( Result = term_pass1_ok(Paths, OutputSupplierMap, SubsetErrors), ( SubsetErrors = [_ | _], ArgSize = arg_size_error(SubsetErrors) ; SubsetErrors = [], ( Paths = [], get_context_from_scc(ModuleInfo, SCC, Context), ArgSizeError = term_error(Context, no_eqns), ArgSize = arg_size_error([ArgSizeError]) ; Paths = [_ | _], solve_equations(Paths, SCCProcs, MaybeSolution), ( MaybeSolution = yes(Solution), ArgSize = arg_size_ok(Solution, OutputSupplierMap) ; MaybeSolution = no, get_context_from_scc(ModuleInfo, SCC, Context), ArgSizeError = term_error(Context, solver_failed), ArgSize = arg_size_error([ArgSizeError]) ) ) ) ; Result = term_pass1_error(Errors), ArgSize = arg_size_error(Errors) ). %-----------------------------------------------------------------------------% % Initialise the output suppliers map. % Initially, we consider that no input arguments contribute their size % to the output arguments. % :- pred init_output_suppliers(module_info::in, list(pred_proc_id)::in, used_args::out) is det. init_output_suppliers(_, [], InitMap) :- map.init(InitMap). init_output_suppliers(ModuleInfo, [PPId | PPIds], OutputSupplierMap) :- init_output_suppliers(ModuleInfo, PPIds, OutputSupplierMap0), module_info_pred_proc_info(ModuleInfo, PPId, _, ProcInfo), proc_info_get_headvars(ProcInfo, HeadVars), MapToNo = (pred(_HeadVar::in, Bool::out) is det :- Bool = no), list.map(MapToNo, HeadVars, BoolList), map.det_insert(PPId, BoolList, OutputSupplierMap0, OutputSupplierMap). %-----------------------------------------------------------------------------% :- pred find_arg_sizes_in_scc_fixpoint(module_info::in, pass_info::in, list(pred_proc_id)::in, used_args::in, pass1_result::out, list(term_error)::out) is det. find_arg_sizes_in_scc_fixpoint(ModuleInfo, PassInfo, SCC, OutputSupplierMap0, Result, TermErrors) :- find_arg_sizes_in_scc_pass(ModuleInfo, PassInfo, SCC, OutputSupplierMap0, [], [], Result0, [], TermErrors0), ( Result0 = term_pass1_error(_), Result = Result0, TermErrors = TermErrors0 ; Result0 = term_pass1_ok(_, OutputSupplierMap1, _), ( if OutputSupplierMap1 = OutputSupplierMap0 then Result = Result0, TermErrors = TermErrors0 else find_arg_sizes_in_scc_fixpoint(ModuleInfo, PassInfo, SCC, OutputSupplierMap1, Result, TermErrors) ) ). :- pred find_arg_sizes_in_scc_pass(module_info::in, pass_info::in, list(pred_proc_id)::in, used_args::in, list(term_path_info)::in, list(term_error)::in, pass1_result::out, list(term_error)::in, list(term_error)::out) is det. find_arg_sizes_in_scc_pass(_, _, [], OutputSupplierMap, Paths, SubsetErrors, Result, !TermErrors) :- Result = term_pass1_ok(Paths, OutputSupplierMap, SubsetErrors). find_arg_sizes_in_scc_pass(ModuleInfo, PassInfo, [PPId | PPIds], OutputSupplierMap0, Paths0, SubsetErrors0, Result, !TermErrors) :- find_arg_sizes_pred(ModuleInfo, PassInfo, PPId, OutputSupplierMap0, Result1, ProcTermErrors), !:TermErrors = !.TermErrors ++ ProcTermErrors, PassInfo = pass_info(_, MaxErrors, _), list.take_upto(MaxErrors, !TermErrors), ( Result1 = term_pass1_error(_), Result = Result1, % The error does not necessarily mean that this SCC is nonterminating. % We need to check that the remainder of this SCC does not make any % nonterminating calls otherwise we might get a software error during % pass 2. % (See below for details). list.foldl(check_proc_non_term_calls(ModuleInfo), PPIds, [], OtherTermErrors), list.append(OtherTermErrors, !TermErrors) ; Result1 = term_pass1_ok(Paths1, OutputSupplierMap1, SubsetErrors1), Paths = Paths0 ++ Paths1, SubsetErrors = SubsetErrors0 ++ SubsetErrors1, find_arg_sizes_in_scc_pass(ModuleInfo, PassInfo, PPIds, OutputSupplierMap1, Paths, SubsetErrors, Result, !TermErrors) ). %-----------------------------------------------------------------------------% :- pred find_arg_sizes_pred(module_info::in, pass_info::in, pred_proc_id::in, used_args::in, pass1_result::out, list(term_error)::out) is det. find_arg_sizes_pred(ModuleInfo, PassInfo, PPId, OutputSupplierMap0, Result, TermErrors) :- module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo), pred_info_get_context(PredInfo, Context), proc_info_get_headvars(ProcInfo, Args), proc_info_get_argmodes(ProcInfo, ArgModes), proc_info_get_var_table(ProcInfo, VarTable), proc_info_get_goal(ProcInfo, Goal0), % The pretest code we add for compiler-generated unification and comparison % predicates uses type casts. It uses them in a way that is guaranteed % to terminate, but our analysis is not (yet) able to find this out for % itself. We therefore analyse only the non-pretest parts of such goals. Goal = maybe_strip_equality_pretest(Goal0), map.init(EmptyMap), PassInfo = pass_info(FunctorInfo, MaxErrors, MaxPaths), init_term_traversal_params(FunctorInfo, PPId, Context, VarTable, OutputSupplierMap0, EmptyMap, MaxErrors, MaxPaths, Params), partition_call_args(ModuleInfo, ArgModes, Args, InVars, OutVars), Path0 = term_path_info(PPId, no, 0, [], OutVars), PathSet0 = set.make_singleton_set(Path0), Info0 = term_traversal_ok(PathSet0, []), term_traverse_goal(ModuleInfo, Params, Goal, Info0, Info), ( Info = term_traversal_ok(Paths, TermErrors), set.to_sorted_list(Paths, PathList), upper_bound_active_vars(PathList, AllActiveVars), map.lookup(OutputSupplierMap0, PPId, OutputSuppliers0), update_output_suppliers(Args, AllActiveVars, OutputSuppliers0, OutputSuppliers), map.det_update(PPId, OutputSuppliers, OutputSupplierMap0, OutputSupplierMap), ( if bag.is_subbag(AllActiveVars, InVars) then SubsetErrors = [] else SubsetErrorKind = not_subset(PPId, AllActiveVars, InVars), SubsetError = term_error(Context, SubsetErrorKind), SubsetErrors = [SubsetError] ), Result = term_pass1_ok(PathList, OutputSupplierMap, SubsetErrors) ; Info = term_traversal_error(Errors, TermErrors), Result = term_pass1_error(Errors) ). :- pred update_output_suppliers(list(prog_var)::in, bag(prog_var)::in, list(bool)::in, list(bool)::out) is det. update_output_suppliers([], _ActiveVars, [], []). update_output_suppliers([_ | _], _ActiveVars, [], []) :- unexpected($pred, "umatched variables"). update_output_suppliers([], _ActiveVars, [_ | _], []) :- unexpected($pred, "umatched variables"). update_output_suppliers([Arg | Args], ActiveVars, [OutputSupplier0 | OutputSuppliers0], [OutputSupplier | OutputSuppliers]) :- ( if bag.contains(ActiveVars, Arg) then OutputSupplier = yes else % This guarantees that the set of output suppliers can only increase, % which in turn guarantees that our fixpoint computation is % monotonic and therefore terminates. OutputSupplier = OutputSupplier0 ), update_output_suppliers(Args, ActiveVars, OutputSuppliers0, OutputSuppliers). %-----------------------------------------------------------------------------% % % Check if a procedure makes any nonterminating calls. % % We only use this if we have detected an error at some point during the % argument size analysis. The idea is to quickly analyse a procedure and see % if it does anything that would prevent us from running pass 2. We cannot % run pass 2 if the procedure contains any calls to nonterminating procedures % lower down the call-graph (see term_pass2.m for details). :- pred check_proc_non_term_calls(module_info::in, pred_proc_id::in, list(term_error)::in, list(term_error)::out) is det. check_proc_non_term_calls(ModuleInfo, PPId, !Errors) :- module_info_pred_proc_info(ModuleInfo, PPId, _, ProcInfo), proc_info_get_goal(ProcInfo, Goal), proc_info_get_var_table(ProcInfo, VarTable), check_goal_non_term_calls(ModuleInfo, PPId, VarTable, Goal, !Errors). :- pred check_goal_non_term_calls(module_info::in, pred_proc_id::in, var_table::in, hlds_goal::in, list(term_error)::in, list(term_error)::out) is det. check_goal_non_term_calls(ModuleInfo, PPId, VarTable, Goal, !Errors) :- Goal = hlds_goal(GoalExpr, GoalInfo), ( GoalExpr = unify(_, _, _, _, _) % Do nothing. ; GoalExpr = plain_call(CallPredId, CallProcId, Args, _, _, _), CallPPId = proc(CallPredId, CallProcId), module_info_pred_proc_info(ModuleInfo, CallPPId, _, ProcInfo), proc_info_get_maybe_termination_info(ProcInfo, TerminationInfo), Context = goal_info_get_context(GoalInfo), ( TerminationInfo = yes(can_loop(_)), CanLoopErrorKind = can_loop_proc_called(PPId, CallPPId), CanLoopError = term_error(Context, CanLoopErrorKind), list.cons(CanLoopError, !Errors) ; ( TerminationInfo = yes(cannot_loop(_)) ; TerminationInfo = no ) ), ( if some_var_is_higher_order(VarTable, Args) then HigherOrderErrorKind = horder_args(PPId, CallPPId), HigherOrderError = term_error(Context, HigherOrderErrorKind), list.cons(HigherOrderError, !Errors) else true ) ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _) % XXX This looks incomplete - juliensf. ; GoalExpr = generic_call(_, _, _, _, _), % XXX We should use any results from closure analysis here. Context = goal_info_get_context(GoalInfo), Error = term_error(Context, horder_call), list.cons(Error, !Errors) ; ( GoalExpr = conj(_, Goals) ; GoalExpr = disj(Goals) ), list.foldl(check_goal_non_term_calls(ModuleInfo, PPId, VarTable), Goals, !Errors) ; GoalExpr = switch(_, _, Cases), list.foldl(check_cases_non_term_calls(ModuleInfo, PPId, VarTable), Cases, !Errors) ; GoalExpr = if_then_else(_, Cond, Then, Else), Goals = [Cond, Then, Else], list.foldl(check_goal_non_term_calls(ModuleInfo, PPId, VarTable), Goals, !Errors) ; GoalExpr = negation(SubGoal), check_goal_non_term_calls(ModuleInfo, PPId, VarTable, SubGoal, !Errors) ; GoalExpr = scope(Reason, SubGoal), ( if Reason = from_ground_term(_, FGT), ( FGT = from_ground_term_construct ; FGT = from_ground_term_deconstruct ) then % The scope has no calls, let alone nonterminating calls. true else check_goal_non_term_calls(ModuleInfo, PPId, VarTable, SubGoal, !Errors) ) ; GoalExpr = shorthand(_), unexpected($pred, "shorthand") ). :- pred check_cases_non_term_calls(module_info::in, pred_proc_id::in, var_table::in, case::in, list(term_error)::in, list(term_error)::out) is det. check_cases_non_term_calls(ModuleInfo, PPId, VarTable, Case, !Errors) :- Case = case(_, _, Goal), check_goal_non_term_calls(ModuleInfo, PPId, VarTable, Goal, !Errors). %-----------------------------------------------------------------------------% % % Solve the list of constraints. % :- pred solve_equations(list(term_path_info)::in, list(pred_proc_id)::in, maybe(list(pair(pred_proc_id, int)))::out) is det. solve_equations(Paths, PPIds, Result) :- ( if convert_equations(Paths, Varset, Equations, Objective, PPVars) then map.values(PPVars, AllVars0), list.sort_and_remove_dups(AllVars0, AllVars), lp_solve(Equations, min, Objective, Varset, AllVars, Soln), ( Soln = unsatisfiable, Result = no ; Soln = satisfiable(_ObjVal, SolnVal), list.map(lookup_coeff(PPVars, SolnVal), PPIds, SolutionList), Result = yes(SolutionList) ) else Result = no ). :- pred convert_equations(list(term_path_info)::in, varset::out, lp.equations::out, objective::out, map(pred_proc_id, var)::out) is semidet. convert_equations(Paths, Varset, Equations, Objective, PPVars) :- varset.init(Varset0), map.init(PPVars0), set.init(EqnSet0), convert_equations_2(Paths, PPVars0, PPVars, Varset0, Varset, EqnSet0, EqnSet), set.to_sorted_list(EqnSet, Equations), map.values(PPVars, Vars), Convert = (pred(Var::in, Coeff::out) is det :- Coeff = Var - 1.0), list.map(Convert, Vars, Objective). :- pred convert_equations_2(list(term_path_info)::in, map(pred_proc_id, var)::in, map(pred_proc_id, var)::out, varset::in, varset::out, set(lp.equation)::in, set(lp.equation)::out) is semidet. convert_equations_2([], !PPVars, !Varset, !Eqns). convert_equations_2([Path | Paths], !PPVars, !Varset, !Eqns) :- Path = term_path_info(ThisPPId, _, IntGamma, PPIds, _), FloatGamma = float(IntGamma), Eqn = eqn(Coeffs, op_ge, FloatGamma), pred_proc_var(ThisPPId, ThisVar, !Varset, !PPVars), Coeffs = [ThisVar - 1.0 | RestCoeffs], Convert = (pred(PPId::in, Coeff::out, !.VS::in, !:VS::out, !.PPV::in, !:PPV::out) is det :- pred_proc_var(PPId, Var, !VS, !PPV), Coeff = Var - (-1.0) ), list.map_foldl2(Convert, PPIds, RestCoeffs, !Varset, !PPVars), set.insert(Eqn, !Eqns), convert_equations_2(Paths, !PPVars, !Varset, !Eqns). :- pred lookup_coeff(map(pred_proc_id, var)::in, map(var, float)::in, pred_proc_id::in, pair(pred_proc_id, int)::out) is det. lookup_coeff(PPIds, Soln, PPId, PPId - ICoeff) :- map.lookup(PPIds, PPId, Var), map.lookup(Soln, Var, Coeff), ICoeff = float.ceiling_to_int(Coeff). :- pred pred_proc_var(pred_proc_id::in, var::out, varset::in, varset::out, map(pred_proc_id, var)::in, map(pred_proc_id, var)::out) is det. pred_proc_var(PPId, Var, !Varset, !PPVars) :- ( if map.search(!.PPVars, PPId, Var0) then Var = Var0 else varset.new_var(Var, !Varset), map.det_insert(PPId, Var, !PPVars) ). %-----------------------------------------------------------------------------% :- end_module transform_hlds.term_pass1. %-----------------------------------------------------------------------------%