%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 2002-2007 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: goal_form.m. % Main authors: conway, zs. % % A module that provides functions that check whether goals fulfill particular % criteria. % %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- module hlds.goal_form. :- interface. :- import_module hlds.hlds_goal. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module bool. :- import_module io. %-----------------------------------------------------------------------------% % An indication of whether a goal can loop forever. % :- type goal_loop_status ---> can_loop ; cannot_loop. % An indication of whether a goal can throw an exception. % :- type goal_throw_status ---> can_throw ; cannot_throw. % An indication of whether a goal can loop forever or throw an exception. % :- type goal_loop_or_throw_status ---> can_loop_or_throw ; cannot_loop_or_throw. %-----------------------------------------------------------------------------% % % These versions use information from the intermodule-analysis framework % % XXX Eventually we will only use these versions and the others can be % deleted. % Return `goal_can_throw' if the given goal may throw an exception; return % `goal_cannot_throw' otherwise. % % This version differs from the ones below in that it can use results from % the intermodule-analysis framework (if they are available). The HLDS % and I/O state need to be threaded through in case analysis files need to % be read and in case IMDGs need to be updated. % :- pred goal_can_throw(hlds_goal::in, goal_throw_status::out, module_info::in, module_info::out, io::di, io::uo) is det. % Return `can_loop_or_throw' if the goal may loop forever or throw an % exception and return `cannot_loop_or_throw' otherwise. % :- pred goal_can_loop_or_throw(hlds_goal::in, goal_loop_or_throw_status::out, module_info::in, module_info::out, io::di, io::uo) is det. %-----------------------------------------------------------------------------% % % The first three versions may be more accurate because they can use % results of the termination and exception analyses. % XXX These don't work with the intermodule-analysis framework, so don't % use them in new code. % Succeeds if the goal cannot loop forever. % :- pred goal_cannot_loop(module_info::in, hlds_goal::in) is semidet. % Succeeds if the goal can loop forever. % :- pred goal_can_loop(module_info::in, hlds_goal::in) is semidet. % Succeeds if the goal cannot throw an exception. % :- pred goal_cannot_throw(module_info::in, hlds_goal::in) is semidet. % Succeeds if the goal can throw an exception. % :- pred goal_can_throw(module_info::in, hlds_goal::in) is semidet. % Succeeds if the goal cannot loop forever or throw an exception. % :- pred goal_cannot_loop_or_throw(module_info::in, hlds_goal::in) is semidet. % Succeeds if the goal can loop forever or throw an exception. % :- pred goal_can_loop_or_throw(module_info::in, hlds_goal::in) is semidet. % % These versions do not use the results of the termination or exception % analyses. % % Succeeds if the goal cannot loop forever or throw an exception. % :- pred goal_cannot_loop_or_throw(hlds_goal::in) is semidet. % Succeed if the goal can loop forever or throw an exception. % :- pred goal_can_loop_or_throw(hlds_goal::in) is semidet. % goal_is_flat(Goal) return `yes' if Goal does not contain any % branched structures (ie if-then-else or disjunctions or switches.) % :- func goal_is_flat(hlds_goal) = bool. % Determine whether a goal might allocate some heap space, i.e. % whether it contains any construction unifications or predicate % calls. BEWARE that this predicate is only an approximation, % used to decide whether or not to try to reclaim the heap % space; currently it fails even for some goals which do % allocate heap space, such as construction of boxed constants. % :- pred goal_may_allocate_heap(hlds_goal::in) is semidet. :- pred goal_list_may_allocate_heap(hlds_goals::in) is semidet. % Succeed if execution of the given goal cannot encounter a context % that causes any variable to be flushed to its stack slot. If such a % goal needs a resume point, and that resume point cannot be % backtracked to once control leaves the goal, then the only entry % point we need for the resume point is the one with the resume % variables in their original locations. % :- pred cannot_stack_flush(hlds_goal::in) is semidet. % Succeed if the given goal cannot fail before encountering a % context that forces all variables to be flushed to their stack % slots. If such a goal needs a resume point, the only entry % point we need is the stack entry point. % :- pred cannot_fail_before_stack_flush(hlds_goal::in) is semidet. % count_recursive_calls(Goal, PredId, ProcId, Min, Max). Given % that we are in predicate PredId and procedure ProcId, return % the minimum and maximum number of recursive calls that an % execution of Goal may encounter. % :- pred count_recursive_calls(hlds_goal::in, pred_id::in, proc_id::in, int::out, int::out) is det. %-----------------------------------------------------------------------------% % % Trail usage % % Returns `yes' if the goal does not modify the trail. % :- func goal_cannot_modify_trail(hlds_goal_info) = bool. % Returns `yes' if the goal may modify the trail. % :- func goal_may_modify_trail(hlds_goal_info) = bool. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module libs.compiler_util. :- import_module parse_tree.prog_data. :- import_module transform_hlds.exception_analysis. :- import_module transform_hlds.term_constr_main. :- import_module bool. :- import_module int. :- import_module list. :- import_module map. :- import_module maybe. :- import_module pair. %-----------------------------------------------------------------------------% % % A version of goal_cannot_loop_or_throw that uses results from the % intermodule-analysis framework % goal_can_throw(hlds_goal(GoalExpr, GoalInfo), Result, !ModuleInfo, !IO) :- Determinism = goal_info_get_determinism(GoalInfo), ( Determinism \= detism_erroneous -> goal_can_throw_2(GoalExpr, GoalInfo, Result, !ModuleInfo, !IO) ; Result = can_throw ). :- pred goal_can_throw_2(hlds_goal_expr::in, hlds_goal_info::in, goal_throw_status::out, module_info::in, module_info::out, io::di, io::uo) is det. goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo, !IO) :- ( Goal = conj(_, Goals) ; Goal = disj(Goals) ; Goal = if_then_else(_, IfGoal, ThenGoal, ElseGoal), Goals = [IfGoal, ThenGoal, ElseGoal] ), goals_can_throw(Goals, Result, !ModuleInfo, !IO). goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo, !IO) :- Goal = plain_call(PredId, ProcId, _, _, _, _), lookup_exception_analysis_result(proc(PredId, ProcId), Status, !ModuleInfo, !IO), ( Status = will_not_throw -> Result = cannot_throw ; Result = can_throw ). goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo, !IO) :- % XXX We should use results form closure analysis here. Goal = generic_call(_, _, _, _), Result = can_throw. goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo, !IO) :- Goal = switch(_, _, Cases), cases_can_throw(Cases, Result, !ModuleInfo, !IO). goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo, !IO) :- Goal = unify(_, _, _, Uni, _), % Complicated unifies are _non_builtin_ ( Uni = complicated_unify(_, _, _) -> Result = can_throw ; Result = cannot_throw ). goal_can_throw_2(OuterGoal, _, Result, !ModuleInfo, !IO) :- ( OuterGoal = negation(InnerGoal) ; OuterGoal = scope(_, InnerGoal) ), goal_can_throw(InnerGoal, Result, !ModuleInfo, !IO). goal_can_throw_2(Goal, _, Result, !ModuleInfo, !IO) :- Goal = call_foreign_proc(Attributes, _, _, _, _, _, _), ExceptionStatus = get_may_throw_exception(Attributes), ( ( ExceptionStatus = proc_will_not_throw_exception ; ExceptionStatus = default_exception_behaviour, get_may_call_mercury(Attributes) = proc_will_not_call_mercury ) -> Result = cannot_throw ; Result = can_throw ). goal_can_throw_2(Goal, _, can_throw, !ModuleInfo, !IO) :- Goal = shorthand(_). % XXX maybe call unexpected/2 here. :- pred goals_can_throw(hlds_goals::in, goal_throw_status::out, module_info::in, module_info::out, io::di, io::uo) is det. goals_can_throw([], cannot_throw, !ModuleInfo, !IO). goals_can_throw([Goal | Goals], Result, !ModuleInfo, !IO) :- goal_can_throw(Goal, Result0, !ModuleInfo, !IO), ( Result0 = cannot_throw, goals_can_throw(Goals, Result, !ModuleInfo, !IO) ; Result0 = can_throw, Result = can_throw ). :- pred cases_can_throw(list(case)::in, goal_throw_status::out, module_info::in, module_info::out, io::di, io::uo) is det. cases_can_throw([], cannot_throw, !ModuleInfo, !IO). cases_can_throw([Case | Cases], Result, !ModuleInfo, !IO) :- Case = case(_, Goal), goal_can_throw(Goal, Result0, !ModuleInfo, !IO), ( Result0 = cannot_throw, cases_can_throw(Cases, Result, !ModuleInfo, !IO) ; Result0 = can_throw, Result = can_throw ). goal_can_loop_or_throw(Goal, Result, !ModuleInfo, !IO) :- % XXX this will need to change after the termination analyses are % converted to use the intermodule-analysis framework. ( goal_cannot_loop(!.ModuleInfo, Goal) -> goal_can_throw(Goal, ThrowResult, !ModuleInfo, !IO), ( ThrowResult = can_throw, Result = can_loop_or_throw ; ThrowResult = cannot_throw, Result = cannot_loop_or_throw ) ; Result = can_loop_or_throw ). %-----------------------------------------------------------------------------% goal_cannot_loop(ModuleInfo, Goal) :- goal_can_loop_func(yes(ModuleInfo), Goal) = no. goal_can_loop(ModuleInfo, Goal) :- goal_can_loop_func(yes(ModuleInfo), Goal) = yes. goal_cannot_throw(ModuleInfo, Goal) :- goal_can_throw_func(yes(ModuleInfo), Goal) = no. goal_can_throw(ModuleInfo, Goal) :- goal_can_throw_func(yes(ModuleInfo), Goal) = yes. goal_cannot_loop_or_throw(ModuleInfo, Goal) :- goal_can_loop_func(yes(ModuleInfo), Goal) = no, goal_can_throw_func(yes(ModuleInfo), Goal) = no. goal_can_loop_or_throw(ModuleInfo, Goal) :- not goal_cannot_loop_or_throw(ModuleInfo, Goal). goal_cannot_loop_or_throw(Goal) :- goal_can_loop_func(no, Goal) = no, goal_can_throw_func(no, Goal) = no. goal_can_loop_or_throw(Goal) :- not goal_cannot_loop_or_throw(Goal). :- func goal_can_loop_func(maybe(module_info), hlds_goal) = bool. goal_can_loop_func(MaybeModuleInfo, hlds_goal(GoalExpr, _)) = goal_expr_can_loop(MaybeModuleInfo, GoalExpr). :- func goal_expr_can_loop(maybe(module_info), hlds_goal_expr) = bool. goal_expr_can_loop(MaybeModuleInfo, conj(plain_conj, Goals)) = goal_list_can_loop(MaybeModuleInfo, Goals). goal_expr_can_loop(_MaybeModuleInfo, conj(parallel_conj, _Goals)) = yes. % In theory, parallel conjunctions can get into deadlocks, which are % effectively a form of nontermination. We can return `no' here only % if we are sure this cannot happen for this conjunction. goal_expr_can_loop(MaybeModuleInfo, disj(Goals)) = goal_list_can_loop(MaybeModuleInfo, Goals). goal_expr_can_loop(MaybeModuleInfo, switch(_Var, _CanFail, Cases)) = case_list_can_loop(MaybeModuleInfo, Cases). goal_expr_can_loop(MaybeModuleInfo, negation(Goal)) = goal_can_loop_func(MaybeModuleInfo, Goal). goal_expr_can_loop(MaybeModuleInfo, scope(_, Goal)) = goal_can_loop_func(MaybeModuleInfo, Goal). goal_expr_can_loop(MaybeModuleInfo, Goal) = CanLoop :- Goal = if_then_else(_Vars, Cond, Then, Else), ( goal_can_loop_func(MaybeModuleInfo, Cond) = yes -> CanLoop = yes ; goal_can_loop_func(MaybeModuleInfo, Then) = yes -> CanLoop = yes ; goal_can_loop_func(MaybeModuleInfo, Else) = yes -> CanLoop = yes ; CanLoop = no ). goal_expr_can_loop(_MaybeModuleInfo, Goal) = CanLoop :- Goal = call_foreign_proc(Attributes, _, _, _, _, _, _), ( Terminates = get_terminates(Attributes), ( Terminates = proc_terminates ; Terminates = depends_on_mercury_calls, get_may_call_mercury(Attributes) = proc_will_not_call_mercury ) -> CanLoop = no ; CanLoop = yes ). goal_expr_can_loop(MaybeModuleInfo, Goal) = CanLoop :- Goal = plain_call(PredId, ProcId, _, _, _, _), ( MaybeModuleInfo = yes(ModuleInfo), module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo), ( proc_info_get_maybe_termination_info(ProcInfo, MaybeTermInfo), MaybeTermInfo = yes(cannot_loop(_)) ; proc_info_get_termination2_info(ProcInfo, Term2Info), Term2Info ^ term_status = yes(cannot_loop(_)) ) -> CanLoop = no ; CanLoop = yes ). goal_expr_can_loop(_MaybeModuleInfo, Goal) = yes :- % We have no idea whether the called goal can throw exceptions, % at least without closure analysis. Goal = generic_call(_, _, _, _). goal_expr_can_loop(_, unify(_, _, _, Uni, _)) = CanLoop :- ( ( Uni = assign(_, _) ; Uni = simple_test(_, _) ; Uni = construct(_, _, _, _, _, _, _) ; Uni = deconstruct(_, _, _, _, _, _) ), CanLoop = no ; Uni = complicated_unify(_, _, _), % It can call, possibly indirectly, a user-specified unification % predicate. CanLoop = yes ). goal_expr_can_loop(_, shorthand(_)) = _ :- unexpected(this_file, "goal_expr_can_loop: shorthand"). :- func goal_list_can_loop(maybe(module_info), list(hlds_goal)) = bool. goal_list_can_loop(_, []) = no. goal_list_can_loop(MaybeModuleInfo, [Goal | Goals]) = ( goal_can_loop_func(MaybeModuleInfo, Goal) = yes -> yes ; goal_list_can_loop(MaybeModuleInfo, Goals) ). :- func case_list_can_loop(maybe(module_info), list(case)) = bool. case_list_can_loop(_, []) = no. case_list_can_loop(MaybeModuleInfo, [case(_, Goal) | Cases]) = ( goal_can_loop_func(MaybeModuleInfo, Goal) = yes -> yes ; case_list_can_loop(MaybeModuleInfo, Cases) ). %-----------------------------------------------------------------------------% goal_cannot_throw(ModuleInfo, Goal) :- goal_can_throw_func(yes(ModuleInfo), Goal) = no. :- func goal_can_throw_func(maybe(module_info), hlds_goal) = bool. goal_can_throw_func(MaybeModuleInfo, hlds_goal(GoalExpr, GoalInfo)) = CanThrow :- Determinism = goal_info_get_determinism(GoalInfo), ( Determinism = detism_erroneous -> CanThrow = yes ; CanThrow = goal_expr_can_throw(MaybeModuleInfo, GoalExpr) ). :- func goal_expr_can_throw(maybe(module_info), hlds_goal_expr) = bool. goal_expr_can_throw(MaybeModuleInfo, conj(_ConjType, Goals)) = goal_list_can_throw(MaybeModuleInfo, Goals). goal_expr_can_throw(MaybeModuleInfo, disj(Goals)) = goal_list_can_throw(MaybeModuleInfo, Goals). goal_expr_can_throw(MaybeModuleInfo, switch(_Var, _Category, Cases)) = case_list_can_throw(MaybeModuleInfo, Cases). goal_expr_can_throw(MaybeModuleInfo, negation(Goal)) = goal_can_throw_func(MaybeModuleInfo, Goal). goal_expr_can_throw(MaybeModuleInfo, scope(_, Goal)) = goal_can_throw_func(MaybeModuleInfo, Goal). goal_expr_can_throw(MaybeModuleInfo, Goal) = CanThrow :- Goal = if_then_else(_, Cond, Then, Else), ( goal_can_throw_func(MaybeModuleInfo, Cond) = yes -> CanThrow = yes ; goal_can_throw_func(MaybeModuleInfo, Then) = yes -> CanThrow = yes ; goal_can_throw_func(MaybeModuleInfo, Else) = yes -> CanThrow = yes ; CanThrow = no ). goal_expr_can_throw(_MaybeModuleInfo, Goal) = CanThrow :- Goal = call_foreign_proc(Attributes, _, _, _, _, _, _), ExceptionStatus = get_may_throw_exception(Attributes), ( ( ExceptionStatus = proc_will_not_throw_exception ; ExceptionStatus = default_exception_behaviour, get_may_call_mercury(Attributes) = proc_will_not_call_mercury ) -> CanThrow = no ; CanThrow = yes ). goal_expr_can_throw(MaybeModuleInfo, Goal) = CanThrow :- Goal = plain_call(PredId, ProcId, _, _, _, _), ( MaybeModuleInfo = yes(ModuleInfo), module_info_get_exception_info(ModuleInfo, ExceptionInfo), map.search(ExceptionInfo, proc(PredId, ProcId), ProcExceptionInfo), ProcExceptionInfo = proc_exception_info(will_not_throw, _) -> CanThrow = no ; CanThrow = yes ). goal_expr_can_throw(_MaybeModuleInfo, Goal) = yes :- % We have no idea whether the called goal can throw exceptions, % at least without closure analysis. Goal = generic_call(_, _, _, _). goal_expr_can_throw(_, unify(_, _, _, Uni, _)) = CanThrow :- % Complicated unifies are _non_builtin_ ( ( Uni = assign(_, _) ; Uni = simple_test(_, _) ; Uni = construct(_, _, _, _, _, _, _) ; Uni = deconstruct(_, _, _, _, _, _) ), CanThrow = no ; Uni = complicated_unify(_, _, _), % It can call, possibly indirectly, a user-specified unification % predicate. CanThrow = yes ). goal_expr_can_throw(_, shorthand(_)) = _ :- unexpected(this_file, "goal_expr_can_throw: shorthand"). :- func goal_list_can_throw(maybe(module_info), list(hlds_goal)) = bool. goal_list_can_throw(_, []) = no. goal_list_can_throw(MaybeModuleInfo, [Goal | Goals]) = ( goal_can_throw_func(MaybeModuleInfo, Goal) = yes -> yes ; goal_list_can_throw(MaybeModuleInfo, Goals) ). :- func case_list_can_throw(maybe(module_info), list(case)) = bool. case_list_can_throw(_, []) = no. case_list_can_throw(MaybeModuleInfo, [case(_, Goal) | Cases]) = ( goal_can_throw_func(MaybeModuleInfo, Goal) = yes -> yes ; case_list_can_throw(MaybeModuleInfo, Cases) ). %-----------------------------------------------------------------------------% goal_is_flat(hlds_goal(GoalExpr, _GoalInfo)) = goal_is_flat_expr(GoalExpr). :- func goal_is_flat_expr(hlds_goal_expr) = bool. goal_is_flat_expr(generic_call(_, _, _, _)) = yes. goal_is_flat_expr(plain_call(_, _, _, _, _, _)) = yes. goal_is_flat_expr(unify(_, _, _, _, _)) = yes. goal_is_flat_expr(call_foreign_proc(_, _, _, _, _, _, _)) = yes. goal_is_flat_expr(conj(ConjType, Goals)) = IsFlat :- ( ConjType = parallel_conj, IsFlat = no ; ConjType = plain_conj, IsFlat = goal_is_flat_list(Goals) ). goal_is_flat_expr(disj(_)) = no. goal_is_flat_expr(switch(_, _, _)) = no. goal_is_flat_expr(if_then_else(_, _, _, _)) = no. goal_is_flat_expr(negation(Goal)) = goal_is_flat(Goal). goal_is_flat_expr(scope(_, Goal)) = goal_is_flat(Goal). goal_is_flat_expr(shorthand(_)) = no. :- func goal_is_flat_list(list(hlds_goal)) = bool. goal_is_flat_list([]) = yes. goal_is_flat_list([Goal | Goals]) = IsFlat :- ( goal_is_flat(Goal) = yes -> IsFlat = goal_is_flat_list(Goals) ; IsFlat = no ). %-----------------------------------------------------------------------------% goal_may_allocate_heap(Goal) :- goal_may_allocate_heap(Goal, yes). goal_list_may_allocate_heap(Goals) :- goal_list_may_allocate_heap(Goals, yes). :- pred goal_may_allocate_heap(hlds_goal::in, bool::out) is det. goal_may_allocate_heap(hlds_goal(GoalExpr, _GoalInfo), May) :- goal_may_allocate_heap_2(GoalExpr, May). :- pred goal_may_allocate_heap_2(hlds_goal_expr::in, bool::out) is det. goal_may_allocate_heap_2(generic_call(_, _, _, _), yes). goal_may_allocate_heap_2(plain_call(_, _, _, Builtin, _, _), May) :- ( Builtin = inline_builtin -> May = no ; May = yes ). goal_may_allocate_heap_2(unify(_, _, _, Unification, _), May) :- ( Unification = construct(_, _, Args, _, _, _, _), Args = [_ | _] -> May = yes ; May = no ). % We cannot safely say that a foreign code fragment does not % allocate memory without knowing all the #defined macros that % expand to incr_hp and variants thereof. % XXX You could make it an attribute of the foreign code and % trust the programmer. goal_may_allocate_heap_2(call_foreign_proc(_, _, _, _, _, _, _), yes). goal_may_allocate_heap_2(scope(_, Goal), May) :- goal_may_allocate_heap(Goal, May). goal_may_allocate_heap_2(negation(Goal), May) :- goal_may_allocate_heap(Goal, May). goal_may_allocate_heap_2(conj(ConjType, Goals), May) :- ( ConjType = parallel_conj, May = yes ; ConjType = plain_conj, goal_list_may_allocate_heap(Goals, May) ). goal_may_allocate_heap_2(disj(Goals), May) :- goal_list_may_allocate_heap(Goals, May). goal_may_allocate_heap_2(switch(_Var, _Det, Cases), May) :- cases_may_allocate_heap(Cases, May). goal_may_allocate_heap_2(if_then_else(_Vars, C, T, E), May) :- ( goal_may_allocate_heap(C, yes) -> May = yes ; goal_may_allocate_heap(T, yes) -> May = yes ; goal_may_allocate_heap(E, May) ). goal_may_allocate_heap_2(shorthand(ShorthandGoal), May) :- goal_may_allocate_heap_2_shorthand(ShorthandGoal, May). :- pred goal_may_allocate_heap_2_shorthand(shorthand_goal_expr::in, bool::out) is det. goal_may_allocate_heap_2_shorthand(bi_implication(G1, G2), May) :- ( goal_may_allocate_heap(G1, yes) -> May = yes ; goal_may_allocate_heap(G2, May) ). :- pred goal_list_may_allocate_heap(list(hlds_goal)::in, bool::out) is det. goal_list_may_allocate_heap([], no). goal_list_may_allocate_heap([Goal | Goals], May) :- ( goal_may_allocate_heap(Goal, yes) -> May = yes ; goal_list_may_allocate_heap(Goals, May) ). :- pred cases_may_allocate_heap(list(case)::in, bool::out) is det. cases_may_allocate_heap([], no). cases_may_allocate_heap([case(_, Goal) | Cases], May) :- ( goal_may_allocate_heap(Goal, yes) -> May = yes ; cases_may_allocate_heap(Cases, May) ). %-----------------------------------------------------------------------------% cannot_stack_flush(hlds_goal(GoalExpr, _)) :- cannot_stack_flush_2(GoalExpr). :- pred cannot_stack_flush_2(hlds_goal_expr::in) is semidet. cannot_stack_flush_2(unify(_, _, _, Unify, _)) :- Unify \= complicated_unify(_, _, _). cannot_stack_flush_2(plain_call(_, _, _, BuiltinState, _, _)) :- BuiltinState = inline_builtin. cannot_stack_flush_2(conj(ConjType, Goals)) :- ConjType = plain_conj, cannot_stack_flush_goals(Goals). cannot_stack_flush_2(switch(_, _, Cases)) :- cannot_stack_flush_cases(Cases). cannot_stack_flush_2(negation(hlds_goal(unify(_, _, _, Unify, _), _))) :- Unify \= complicated_unify(_, _, _). :- pred cannot_stack_flush_goals(list(hlds_goal)::in) is semidet. cannot_stack_flush_goals([]). cannot_stack_flush_goals([Goal | Goals]) :- cannot_stack_flush(Goal), cannot_stack_flush_goals(Goals). :- pred cannot_stack_flush_cases(list(case)::in) is semidet. cannot_stack_flush_cases([]). cannot_stack_flush_cases([case(_, Goal) | Cases]) :- cannot_stack_flush(Goal), cannot_stack_flush_cases(Cases). %-----------------------------------------------------------------------------% cannot_fail_before_stack_flush(hlds_goal(GoalExpr, GoalInfo)) :- Detism = goal_info_get_determinism(GoalInfo), determinism_components(Detism, CanFail, _), ( CanFail = cannot_fail ; CanFail = can_fail, cannot_fail_before_stack_flush_2(GoalExpr) ). :- pred cannot_fail_before_stack_flush_2(hlds_goal_expr::in) is semidet. cannot_fail_before_stack_flush_2(conj(ConjType, Goals)) :- ConjType = plain_conj, cannot_fail_before_stack_flush_conj(Goals). :- pred cannot_fail_before_stack_flush_conj(list(hlds_goal)::in) is semidet. cannot_fail_before_stack_flush_conj([]). cannot_fail_before_stack_flush_conj([Goal | Goals]) :- Goal = hlds_goal(GoalExpr, GoalInfo), ( ( GoalExpr = plain_call(_, _, _, BuiltinState, _, _), BuiltinState \= inline_builtin ; GoalExpr = generic_call(_, _, _, _) ) -> true ; Detism = goal_info_get_determinism(GoalInfo), determinism_components(Detism, cannot_fail, _) -> cannot_fail_before_stack_flush_conj(Goals) ; fail ). %-----------------------------------------------------------------------------% count_recursive_calls(hlds_goal(GoalExpr, _), PredId, ProcId, Min, Max) :- count_recursive_calls_2(GoalExpr, PredId, ProcId, Min, Max). :- pred count_recursive_calls_2(hlds_goal_expr::in, pred_id::in, proc_id::in, int::out, int::out) is det. count_recursive_calls_2(negation(Goal), PredId, ProcId, Min, Max) :- count_recursive_calls(Goal, PredId, ProcId, Min, Max). count_recursive_calls_2(scope(_, Goal), PredId, ProcId, Min, Max) :- count_recursive_calls(Goal, PredId, ProcId, Min, Max). count_recursive_calls_2(unify(_, _, _, _, _), _, _, 0, 0). count_recursive_calls_2(generic_call(_, _, _, _), _, _, 0, 0). count_recursive_calls_2(call_foreign_proc(_, _, _, _, _, _, _), _, _, 0, 0). count_recursive_calls_2(plain_call(CallPredId, CallProcId, _, _, _, _), PredId, ProcId, Count, Count) :- ( PredId = CallPredId, ProcId = CallProcId -> Count = 1 ; Count = 0 ). count_recursive_calls_2(conj(_, Goals), PredId, ProcId, Min, Max) :- count_recursive_calls_conj(Goals, PredId, ProcId, 0, 0, Min, Max). count_recursive_calls_2(disj(Goals), PredId, ProcId, Min, Max) :- count_recursive_calls_disj(Goals, PredId, ProcId, Min, Max). count_recursive_calls_2(switch(_, _, Cases), PredId, ProcId, Min, Max) :- count_recursive_calls_cases(Cases, PredId, ProcId, Min, Max). count_recursive_calls_2(if_then_else(_, Cond, Then, Else), PredId, ProcId, Min, Max) :- count_recursive_calls(Cond, PredId, ProcId, CMin, CMax), count_recursive_calls(Then, PredId, ProcId, TMin, TMax), count_recursive_calls(Else, PredId, ProcId, EMin, EMax), CTMin = CMin + TMin, CTMax = CMax + TMax, int.min(CTMin, EMin, Min), int.max(CTMax, EMax, Max). count_recursive_calls_2(shorthand(_), _, _, _, _) :- % these should have been expanded out by now unexpected(this_file, "count_recursive_calls_2: unexpected shorthand"). :- pred count_recursive_calls_conj(list(hlds_goal)::in, pred_id::in, proc_id::in, int::in, int::in, int::out, int::out) is det. count_recursive_calls_conj([], _, _, Min, Max, Min, Max). count_recursive_calls_conj([Goal | Goals], PredId, ProcId, Min0, Max0, Min, Max) :- count_recursive_calls(Goal, PredId, ProcId, Min1, Max1), Min2 = Min0 + Min1, Max2 = Max0 + Max1, count_recursive_calls_conj(Goals, PredId, ProcId, Min2, Max2, Min, Max). :- pred count_recursive_calls_disj(list(hlds_goal)::in, pred_id::in, proc_id::in, int::out, int::out) is det. count_recursive_calls_disj([], _, _, 0, 0). count_recursive_calls_disj([Goal | Goals], PredId, ProcId, Min, Max) :- ( Goals = [], count_recursive_calls(Goal, PredId, ProcId, Min, Max) ; Goals = [_ | _], count_recursive_calls(Goal, PredId, ProcId, Min0, Max0), count_recursive_calls_disj(Goals, PredId, ProcId, Min1, Max1), int.min(Min0, Min1, Min), int.max(Max0, Max1, Max) ). :- pred count_recursive_calls_cases(list(case)::in, pred_id::in, proc_id::in, int::out, int::out) is det. count_recursive_calls_cases([], _, _, _, _) :- unexpected(this_file, "empty cases in count_recursive_calls_cases"). count_recursive_calls_cases([case(_, Goal) | Cases], PredId, ProcId, Min, Max) :- ( Cases = [], count_recursive_calls(Goal, PredId, ProcId, Min, Max) ; Cases = [_ | _], count_recursive_calls(Goal, PredId, ProcId, Min0, Max0), count_recursive_calls_cases(Cases, PredId, ProcId, Min1, Max1), int.min(Min0, Min1, Min), int.max(Max0, Max1, Max) ). %-----------------------------------------------------------------------------% % % Trail usage % goal_cannot_modify_trail(GoalInfo) = ( goal_info_has_feature(GoalInfo, feature_will_not_modify_trail) -> yes ; no ). goal_may_modify_trail(GoalInfo) = bool.not(goal_cannot_modify_trail(GoalInfo)). %-----------------------------------------------------------------------------% :- func this_file = string. this_file = "goal_form.m". %-----------------------------------------------------------------------------% :- end_module goal_form. %-----------------------------------------------------------------------------%