%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 1999-2012 University of Melbourne. % Copyright (C) 2015, 2017 The Mercury team. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %-----------------------------------------------------------------------------% % % File: deforest.m. % Main author: stayl. % % Deforestation attempts to remove multiple traversals over data structures, % and construction followed by immediate deconstruction of data structures. % It does this by combining the bodies of pairs of called procedures in a % conjunction where the top-level functor of one of the argument variables of % the first called procedure is known at the end of some of the branches of % the body of that procedure, and the second called procedure switches on that % variable. % % The deforestation pass also inlines calls for which the top-level goal in % the called procedure is a switch and the functor of the switched-on variable % is known. This allows simplify.m to prune away the failing branches. % % The constraint propagation pass, which is called from the deforestation % pass, transforms the code so that goals which could fail are executed as % early as possible. % % For a more detailed description, see Simon Taylor's Honours thesis, % available from the papers page of mercurylang.org. % %-----------------------------------------------------------------------------% :- module transform_hlds.deforest. :- interface. :- import_module hlds. :- import_module hlds.hlds_module. :- import_module io. %-----------------------------------------------------------------------------% :- pred deforest_module(io.text_output_stream::in, module_info::in, module_info::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module check_hlds. :- import_module check_hlds.det_analysis. :- import_module check_hlds.det_report. :- import_module check_hlds.inst_test. :- import_module check_hlds.modecheck_util. :- import_module check_hlds.recompute_instmap_deltas. :- import_module check_hlds.simplify. :- import_module check_hlds.simplify.simplify_tasks. :- import_module check_hlds.type_util. :- import_module hlds.goal_form. :- import_module hlds.goal_util. :- import_module hlds.hlds_dependency_graph. :- import_module hlds.hlds_goal. :- import_module hlds.hlds_pred. :- import_module hlds.instmap. :- import_module hlds.passes_aux. :- import_module hlds.quantification. :- import_module libs. :- import_module libs.dependency_graph. :- import_module libs.globals. :- import_module libs.optimization_options. :- import_module libs.options. :- import_module mdbcomp. :- import_module mdbcomp.sym_name. :- import_module parse_tree. :- import_module parse_tree.error_util. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_detism. :- import_module parse_tree.prog_type_subst. :- import_module parse_tree.set_of_var. :- import_module parse_tree.var_table. :- import_module transform_hlds.inlining. :- import_module transform_hlds.pd_cost. :- import_module transform_hlds.pd_debug. :- import_module transform_hlds.pd_info. :- import_module transform_hlds.pd_term. :- import_module transform_hlds.pd_util. :- import_module assoc_list. :- import_module bool. :- import_module getopt. :- import_module int. :- import_module list. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module set. :- import_module string. :- import_module term. :- import_module univ. :- import_module varset. %-----------------------------------------------------------------------------% deforest_module(ProgressStream, !ModuleInfo) :- proc_arg_info_init(ProcArgInfo0), type_to_univ(ProcArgInfo0, UnivProcArgInfo0), % Find out which arguments of each procedure are switched on at the top % level or are constructed in a way which is possibly deforestable. Task0 = update_module_cookie(get_branch_vars_proc_univ, UnivProcArgInfo0), process_valid_nonimported_procs_update(Task0, Task, !ModuleInfo), ( if Task = update_module_cookie(_, UnivProcArgInfo), univ_to_type(UnivProcArgInfo, ProcArgInfo1) then ProcArgInfo = ProcArgInfo1 else unexpected($pred, "passes_aux stuffed up") ), % We process the module bottom-up to make estimation of the % cost improvement of new versions a little more accurate and % also to avoid redoing optimizations. module_info_ensure_dependency_info(!ModuleInfo, DepInfo), DepList = dependency_info_get_condensed_bottom_up_sccs(DepInfo), pd_info_init(ProgressStream, !.ModuleInfo, ProcArgInfo, PDInfo0), list.foldl(deforest_proc, DepList, PDInfo0, PDInfo), pd_info_get_module_info(PDInfo, !:ModuleInfo), module_info_clobber_dependency_info(!ModuleInfo), pd_info_get_versions(PDInfo, VersionIndex), map.keys(VersionIndex, Versions), module_info_get_globals(!.ModuleInfo, Globals), globals.get_opt_tuple(Globals, OptTuple), PropConstraints = OptTuple ^ ot_prop_constraints, ( if PropConstraints = prop_constraints, Versions = [_ | _] then % We can sometimes improve efficiency by rerunning determinism % inference on the specialized versions after constraint propagation, % because some nondet predicates will have become semidet. list.foldl(reset_inferred_proc_determinism, Versions, !ModuleInfo), disable_det_warnings(_OptionsToRestore, Globals, NoWarnGlobals), module_info_set_globals(NoWarnGlobals, !ModuleInfo), determinism_pass(!ModuleInfo, Specs), module_info_set_globals(Globals, !ModuleInfo), FoundErrors = contains_errors(Globals, Specs), expect(unify(FoundErrors, no), $pred, "determinism errors after deforestation") else true ). :- pred reset_inferred_proc_determinism(pred_proc_id::in, module_info::in, module_info::out) is det. reset_inferred_proc_determinism(PredProcId, !ModuleInfo) :- module_info_pred_proc_info(!.ModuleInfo, PredProcId, PredInfo, ProcInfo0), proc_info_get_inferred_determinism(ProcInfo0, Detism0), determinism_components(Detism0, _, MaxSolns), ( MaxSolns = at_most_many_cc % `cc_multi' or `cc_nondet' determinisms are never inferred, % so resetting the determinism would cause determinism errors. ; ( MaxSolns = at_most_zero ; MaxSolns = at_most_one ; MaxSolns = at_most_many ), proc_info_set_inferred_determinism(detism_erroneous, ProcInfo0, ProcInfo), module_info_set_pred_proc_info(PredProcId, PredInfo, ProcInfo, !ModuleInfo) ). :- pred proc_arg_info_init(map(pred_proc_id, pd_proc_arg_info)::out) is det. proc_arg_info_init(ProcArgInfo0) :- map.init(ProcArgInfo0). :- pred get_branch_vars_proc_univ(pred_proc_id::in, proc_info::in, proc_info::out, module_info::in, module_info::out, univ::in, univ::out) is det. get_branch_vars_proc_univ(PredProcId, ProcInfo, ProcInfo, !ModuleInfo, UnivProcArgInfo0, UnivProcArgInfo) :- det_univ_to_type(UnivProcArgInfo0, ProcArgInfo0), pd_util.get_branch_vars_proc(PredProcId, ProcInfo, !ModuleInfo, ProcArgInfo0, ProcArgInfo), type_to_univ(ProcArgInfo, UnivProcArgInfo). :- pred deforest_proc(pred_proc_id::in, pd_info::in, pd_info::out) is det. deforest_proc(PredProcId, !PDInfo) :- deforest_proc_deltas(PredProcId, _, _, !PDInfo). :- pred deforest_proc_deltas(pred_proc_id::in, int::out, int::out, pd_info::in, pd_info::out) is det. deforest_proc_deltas(PredProcId, CostDelta, SizeDelta, !PDInfo) :- some [!ModuleInfo, !PredInfo, !ProcInfo, !Goal] ( pd_info_get_progress_stream(!.PDInfo, ProgressStream), pd_info_get_module_info(!.PDInfo, !:ModuleInfo), trace [io(!IO)] ( maybe_write_proc_progress_message(ProgressStream, !.ModuleInfo, "Deforesting", PredProcId, !IO) ), module_info_pred_proc_info(!.ModuleInfo, PredProcId, !:PredInfo, !:ProcInfo), pd_info_init_unfold_info(PredProcId, !.PredInfo, !.ProcInfo, !PDInfo), proc_info_get_goal(!.ProcInfo, !:Goal), % Inlining may have created some opportunities for simplification. module_info_get_globals(!.ModuleInfo, Globals), find_simplify_tasks(Globals, do_not_generate_warnings, SimplifyTasks), pd_util.pd_simplify_goal(SimplifyTasks, !Goal, !PDInfo), pd_util.propagate_constraints(!Goal, !PDInfo), trace [io(!IO)] ( pd_debug_output_goal(!.PDInfo, "after constraints\n", !.Goal, !IO) ), deforest_goal(!Goal, !PDInfo), pd_info_get_proc_info(!.PDInfo, !:ProcInfo), proc_info_set_goal(!.Goal, !ProcInfo), pd_info_get_changed(!.PDInfo, Changed), ( Changed = yes, pd_info_get_module_info(!.PDInfo, !:ModuleInfo), requantify_proc_general(ord_nl_no_lambda, !ProcInfo), proc_info_get_goal(!.ProcInfo, !:Goal), proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InstMap0), proc_info_get_var_table(!.ProcInfo, VarTable), proc_info_get_inst_varset(!.ProcInfo, InstVarSet), recompute_instmap_delta(recomp_atomics, VarTable, InstVarSet, InstMap0, !Goal, !ModuleInfo), pd_info_set_module_info(!.ModuleInfo, !PDInfo), pd_info_get_pred_info(!.PDInfo, !:PredInfo), proc_info_set_goal(!.Goal, !ProcInfo), module_info_set_pred_proc_info(PredProcId, !.PredInfo, !.ProcInfo, !ModuleInfo), pd_info_get_rerun_det(!.PDInfo, RerunDet), ( RerunDet = yes, PredProcId = proc(PredId, ProcId), % If the determinism of some sub-goals has changed, % then we re-run determinism analysis. As with inlining.m, % this avoids problems with inlining erroneous procedures. det_infer_proc_ignore_msgs(PredId, ProcId, !ModuleInfo) ; RerunDet = no ), % Recompute the branch_info for the procedure. pd_info_get_proc_arg_info(!.PDInfo, ProcArgInfo0), pd_util.get_branch_vars_proc(PredProcId, !.ProcInfo, !ModuleInfo, ProcArgInfo0, ProcArgInfo), pd_info_set_proc_arg_info(ProcArgInfo, !PDInfo), pd_info_set_module_info(!.ModuleInfo, !PDInfo) ; Changed = no, pd_info_get_module_info(!.PDInfo, !:ModuleInfo), pd_info_get_pred_info(!.PDInfo, !:PredInfo), module_info_set_pred_proc_info(PredProcId, !.PredInfo, !.ProcInfo, !ModuleInfo), pd_info_set_module_info(!.ModuleInfo, !PDInfo) ), pd_info_get_module_info(!.PDInfo, !:ModuleInfo), trace [io(!IO)] ( maybe_write_proc_progress_message(ProgressStream, !.ModuleInfo, "Finished deforesting", PredProcId, !IO) ), pd_info_get_cost_delta(!.PDInfo, CostDelta), pd_info_get_size_delta(!.PDInfo, SizeDelta), pd_info_unset_unfold_info(!PDInfo) ). :- pred deforest_goal(hlds_goal::in, hlds_goal::out, pd_info::in, pd_info::out) is det. deforest_goal(Goal0, Goal, !PDInfo) :- Goal0 = hlds_goal(GoalExpr0, GoalInfo0), deforest_goal_expr(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !PDInfo), Goal = hlds_goal(GoalExpr, GoalInfo). :- pred deforest_goal_expr(hlds_goal_expr::in, hlds_goal_expr::out, hlds_goal_info::in, hlds_goal_info::out, pd_info::in, pd_info::out) is det. deforest_goal_expr(GoalExpr0, GoalExpr, !GoalInfo, !PDInfo) :- ( GoalExpr0 = conj(ConjType, Goals0), some [!Goals] ( !:Goals = Goals0, ( ConjType = plain_conj, pd_info_get_instmap(!.PDInfo, InstMap0), partially_evaluate_conj_goals(!.Goals, [], !:Goals, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo), NonLocals = goal_info_get_nonlocals(!.GoalInfo), pd_info_get_module_info(!.PDInfo, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), globals.get_opt_tuple(Globals, OptTuple), Deforest = OptTuple ^ ot_deforest, ( Deforest = deforest, compute_goal_infos(!Goals, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo), deforest_conj(!.Goals, NonLocals, [], !:Goals, !PDInfo) ; Deforest = do_not_deforest ), PropConstraints = OptTuple ^ ot_prop_constraints, pd_info_set_instmap(InstMap0, !PDInfo), ( PropConstraints = prop_constraints, propagate_conj_constraints(!.Goals, NonLocals, [], !:Goals, !PDInfo) ; PropConstraints = do_not_prop_constraints ), pd_info_set_instmap(InstMap0, !PDInfo) ; ConjType = parallel_conj % XXX cannot deforest across parallel_conjunctions! ), Goals = !.Goals ), GoalExpr = conj(ConjType, Goals) ; GoalExpr0 = disj(Goals0), deforest_disj(Goals0, Goals, !PDInfo), GoalExpr = disj(Goals) ; GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0), pd_info_get_instmap(!.PDInfo, InstMap0), deforest_goal(Cond0, Cond, !PDInfo), pd_info_update_goal(Cond, !PDInfo), deforest_goal(Then0, Then, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo), deforest_goal(Else0, Else, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo), GoalExpr = if_then_else(Vars, Cond, Then, Else) ; GoalExpr0 = switch(Var, CanFail, Cases0), deforest_cases(Var, Cases0, Cases, !PDInfo), GoalExpr = switch(Var, CanFail, Cases) ; GoalExpr0 = negation(SubGoal0), deforest_goal(SubGoal0, SubGoal, !PDInfo), GoalExpr = negation(SubGoal) ; GoalExpr0 = scope(Reason, SubGoal0), ( if Reason = from_ground_term(_, FGT), ( FGT = from_ground_term_construct ; FGT = from_ground_term_deconstruct ) then SubGoal = SubGoal0 else deforest_goal(SubGoal0, SubGoal, !PDInfo) ), GoalExpr = scope(Reason, SubGoal) ; GoalExpr0 = plain_call(PredId, ProcId, Args, BuiltinState, _, Name), deforest_call(PredId, ProcId, Args, Name, BuiltinState, hlds_goal(GoalExpr0, !.GoalInfo), hlds_goal(GoalExpr, !:GoalInfo), !PDInfo) ; ( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _) ; GoalExpr0 = generic_call(_, _, _, _, _) ; GoalExpr = unify(_, _, _, _, _) ), GoalExpr = GoalExpr0 ; GoalExpr0 = shorthand(_), % These should have been expanded out by now. unexpected($pred, "shorthand") ). %-----------------------------------------------------------------------------% :- pred deforest_disj(list(hlds_goal)::in, list(hlds_goal)::out, pd_info::in, pd_info::out) is det. deforest_disj([], [], !PDInfo). deforest_disj([Goal0 | Goals0], [Goal | Goals], !PDInfo) :- pd_info_get_instmap(!.PDInfo, InstMap0), deforest_goal(Goal0, Goal, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo), deforest_disj(Goals0, Goals, !PDInfo). %-----------------------------------------------------------------------------% :- pred deforest_cases(prog_var::in, list(case)::in, list(case)::out, pd_info::in, pd_info::out) is det. deforest_cases(_, [], [], !PDInfo). deforest_cases(Var, [Case0 | Cases0], [Case | Cases], !PDInfo) :- Case0 = case(MainConsId, OtherConsIds, Goal0), % Bind Var to MainConsId or one of the OtherConsIds in the instmap % before processing this case. pd_info_get_instmap(!.PDInfo, InstMap0), pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo), deforest_goal(Goal0, Goal, !PDInfo), Case = case(MainConsId, OtherConsIds, Goal), pd_info_set_instmap(InstMap0, !PDInfo), deforest_cases(Var, Cases0, Cases, !PDInfo). %-----------------------------------------------------------------------------% % Perform partial evaluation on the goals of a conjunction. % :- pred partially_evaluate_conj_goals(list(hlds_goal)::in, list(hlds_goal)::in, list(hlds_goal)::out, pd_info::in, pd_info::out) is det. partially_evaluate_conj_goals([], RevGoals, Goals, !PDInfo) :- list.reverse(RevGoals, Goals). partially_evaluate_conj_goals([Goal0 | Goals0], RevGoals0, Goals, !PDInfo) :- deforest_goal(Goal0, Goal1, !PDInfo), pd_info_update_goal(Goal1, !PDInfo), ( if Goal1 = hlds_goal(conj(plain_conj, Goals1), _) then list.reverse(Goals1, RevGoals1), list.append(RevGoals1, RevGoals0, RevGoals2) else RevGoals2 = [Goal1 | RevGoals0] ), partially_evaluate_conj_goals(Goals0, RevGoals2, Goals, !PDInfo). %-----------------------------------------------------------------------------% % Compute the branch info for each goal in a conjunction. % :- pred compute_goal_infos(list(hlds_goal)::in, annotated_conj::out, pd_info::in, pd_info::out) is det. compute_goal_infos([], [], !PDInfo). compute_goal_infos([Goal | Goals0], [Goal - MaybeBranchInfo | Goals], !PDInfo) :- deforest_get_branch_vars_goal(Goal, MaybeBranchInfo, !PDInfo), pd_info_update_goal(Goal, !PDInfo), compute_goal_infos(Goals0, Goals, !PDInfo). :- pred deforest_get_branch_vars_goal(hlds_goal::in, maybe(pd_branch_info(prog_var))::out, pd_info::in, pd_info::out) is det. deforest_get_branch_vars_goal(Goal, MaybeBranchInfo, !PDInfo) :- Goal = hlds_goal(GoalExpr, _), ( ( GoalExpr = disj(_) ; GoalExpr = switch(_, _, _) ; GoalExpr = if_then_else(_, _, _, _) ), pd_util.get_branch_vars_goal(Goal, MaybeBranchInfo, !PDInfo) ; ( GoalExpr = unify(_, _, _, _, _) ; GoalExpr = generic_call(_, _, _, _, _) ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _) ; GoalExpr = conj(_, _) ; GoalExpr = negation(_) ; GoalExpr = scope(_, _) ), MaybeBranchInfo = no ; GoalExpr = plain_call(PredId, ProcId, Args, _, _, _), pd_info_get_proc_arg_info(!.PDInfo, ProcBranchInfos), ( if map.search(ProcBranchInfos, proc(PredId, ProcId), BranchInfo0) then % Rename the branch_info for the called procedure % onto the argument variables. pd_util.convert_branch_info(BranchInfo0, Args, BranchInfo), MaybeBranchInfo = yes(BranchInfo) else MaybeBranchInfo = no ) ; GoalExpr = shorthand(_), unexpected($pred, "shorthand") ). %-----------------------------------------------------------------------------% :- pred propagate_conj_constraints(list(hlds_goal)::in, set_of_progvar::in, list(hlds_goal)::in, list(hlds_goal)::out, pd_info::in, pd_info::out) is det. propagate_conj_constraints([], _, RevGoals, Goals, !PDInfo) :- list.reverse(RevGoals, Goals). propagate_conj_constraints([Goal0 | Goals0], NonLocals, RevGoals0, Goals, !PDInfo) :- pd_info_get_module_info(!.PDInfo, ModuleInfo), ( if % constraint.m ensures that only constraints relevant % to this goal are placed adjacent to it. Goal0 = hlds_goal(GoalExpr0, _GoalInfo0), GoalExpr0 = plain_call(PredId, _ProcId, _Args, _, _, SymName), module_info_pred_info(ModuleInfo, PredId, PredInfo), not pred_info_is_imported(PredInfo), list.take_while( ( pred(CnstrGoal::in) is semidet :- CnstrGoal = hlds_goal(_, CnstrGoalInfo), goal_info_has_feature(CnstrGoalInfo, feature_constraint) ), Goals0, Constraints, Goals1), Constraints = [_ | _] then SymNameString = sym_name_to_string(SymName), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "propagating constraints into call to %s\n", [s(SymNameString)], !IO) ), do_get_sub_conj_nonlocals(NonLocals, RevGoals0, [], Goal0, Constraints, no, [], Goals1, ConjNonLocals), call_call(ConjNonLocals, Goal0, Constraints, no, MaybeGoal, !PDInfo), ( MaybeGoal = yes(Goal), pd_info_set_rerun_det(yes, !PDInfo), pd_info_update_goal(Goal, !PDInfo), propagate_conj_constraints(Goals1, NonLocals, [Goal | RevGoals0], Goals, !PDInfo) ; MaybeGoal = no, pd_info_update_goal(Goal0, !PDInfo), propagate_conj_constraints(Goals0, NonLocals, [Goal0 | RevGoals0], Goals, !PDInfo) ) else pd_info_update_goal(Goal0, !PDInfo), propagate_conj_constraints(Goals0, NonLocals, [Goal0 | RevGoals0], Goals, !PDInfo) ). %-----------------------------------------------------------------------------% :- type annotated_conj == assoc_list(hlds_goal, maybe(pd_branch_info(prog_var))). :- pred deforest_conj(annotated_conj::in, set_of_progvar::in, list(hlds_goal)::in, list(hlds_goal)::out, pd_info::in, pd_info::out) is det. deforest_conj([], _, RevGoals, Goals, !PDInfo) :- list.reverse(RevGoals, Goals). deforest_conj([Goal0 - MaybeBranchInfo | Goals0], NonLocals, RevGoals0, RevGoals, !PDInfo) :- ( if % Look for a goal later in the conjunction to deforest with. MaybeBranchInfo = yes(GoalBranchInfo), detect_deforestation(Goal0, GoalBranchInfo, Goals0, Goals1, DeforestInfo) then handle_deforestation(NonLocals, DeforestInfo, RevGoals0, RevGoals1, Goals1, Goals2, Optimized, !PDInfo), ( Optimized = yes, deforest_conj(Goals2, NonLocals, RevGoals1, RevGoals, !PDInfo) ; Optimized = no, pd_info_update_goal(Goal0, !PDInfo), RevGoals2 = [Goal0 | RevGoals0], deforest_conj(Goals0, NonLocals, RevGoals2, RevGoals, !PDInfo) ) else pd_info_update_goal(Goal0, !PDInfo), RevGoals1 = [Goal0 | RevGoals0], deforest_conj(Goals0, NonLocals, RevGoals1, RevGoals, !PDInfo) ). %-----------------------------------------------------------------------------% :- type deforest_info ---> deforest_info( hlds_goal, % earlier goal in conjunction pd_branch_info(prog_var), % branch_info for earlier goal list(hlds_goal), % goals in between hlds_goal, % later goal in conjunction pd_branch_info(prog_var), % branch_info for later goal set(int) % branches for which there is % extra information about the % second goal, numbering starts % at 1. ). % Search backwards through the conjunction for the last goal which contains % extra information about the variable being switched on. % :- pred detect_deforestation(hlds_goal::in, pd_branch_info(prog_var)::in, annotated_conj::in, annotated_conj::out, deforest_info::out) is semidet. detect_deforestation(EarlierGoal, BranchInfo, !Goals, DeforestInfo) :- search_for_deforest_goal(EarlierGoal, BranchInfo, [], !Goals, DeforestInfo). :- pred search_for_deforest_goal(hlds_goal::in, pd_branch_info(prog_var)::in, annotated_conj::in, annotated_conj::in, annotated_conj::out, deforest_info::out) is semidet. search_for_deforest_goal(EarlierGoal, EarlierBranchInfo, RevBetweenGoals0, [Goal | Goals0], Goals, DeforestInfo) :- ( if Goal = LaterGoal - yes(LaterBranchInfo), potential_deforestation(EarlierBranchInfo, LaterBranchInfo, DeforestBranches) then list.reverse(RevBetweenGoals0, BetweenGoals1), assoc_list.keys(BetweenGoals1, BetweenGoals), Goals = Goals0, DeforestInfo = deforest_info(EarlierGoal, EarlierBranchInfo, BetweenGoals, LaterGoal, LaterBranchInfo, DeforestBranches) else search_for_deforest_goal(EarlierGoal, EarlierBranchInfo, [Goal | RevBetweenGoals0], Goals0, Goals, DeforestInfo) ). % Look for a variable in the second branch_info for which we have more % information in the first than in the instmap. Get the branches in the % first goal which contain this extra information. % :- pred potential_deforestation(pd_branch_info(prog_var)::in, pd_branch_info(prog_var)::in, set(int)::out) is semidet. potential_deforestation(Info1, Info2, DeforestBranches) :- Info1 = pd_branch_info(VarMap1, _, _), Info2 = pd_branch_info(_, LeftVars2, _), map.select(VarMap1, LeftVars2, VarMap), map.to_assoc_list(VarMap, VarAssoc), not map.is_empty(VarMap), % Work out which branches of the first goal should contain % unfolded versions of the second goal. GetBranches = ( pred(VarInfo::in, Branches0::in, Branches::out) is det :- VarInfo = _ - Branches1, set.union(Branches0, Branches1, Branches) ), set.init(DeforestBranches0), list.foldl(GetBranches, VarAssoc, DeforestBranches0, DeforestBranches). %-----------------------------------------------------------------------------% % Take the part of a conjunction found to have potential % for deforestation and attempt the optimization. % :- pred handle_deforestation(set_of_progvar::in, deforest_info::in, list(hlds_goal)::in, list(hlds_goal)::out, annotated_conj::in, annotated_conj::out, bool::out, pd_info::in, pd_info::out) is det. handle_deforestation(NonLocals, DeforestInfo0, !RevBeforeGoals, !AfterGoals, Optimized, !PDInfo) :- pd_info_get_module_info(!.PDInfo, ModuleInfo), pd_info_get_instmap(!.PDInfo, InstMap0), pd_info_get_created_versions(!.PDInfo, CreatedVersions0), pd_info_get_depth(!.PDInfo, Depth0), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "checking for deforestation at depth %i\n", [i(Depth0)], !IO) ), reorder_conj(DeforestInfo0, DeforestInfo, BeforeIrrelevant, AfterIrrelevant, !.PDInfo), get_sub_conj_nonlocals(NonLocals, DeforestInfo, !.RevBeforeGoals, BeforeIrrelevant, AfterIrrelevant, !.AfterGoals, ConjNonLocals), % Update the instmap. list.foldl(pd_info_update_goal, BeforeIrrelevant, !PDInfo), pd_info_get_pred_proc_id(!.PDInfo, CurrPredProcId), pd_info_get_parents(!.PDInfo, Parents0), pd_info_get_cost_delta(!.PDInfo, CostDelta0), pd_info_get_size_delta(!.PDInfo, SizeDelta0), DeforestInfo = deforest_info(EarlierGoal, _, BetweenGoals, LaterGoal, _, DeforestBranches), should_try_deforestation(DeforestInfo, ShouldOptimize, !PDInfo), ( ShouldOptimize = no, Optimized0 = no, Goals = [] ; ShouldOptimize = yes, ( if EarlierGoal = hlds_goal(plain_call(PredId1, _, _, _, _, _), _), LaterGoal = hlds_goal(plain_call(PredId2, _, _, _, _, _), _) then % If both goals are calls create a new predicate for the % conjunction to be deforested and process it. PredName1 = predicate_name(ModuleInfo, PredId1), PredName2 = predicate_name(ModuleInfo, PredId2), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "deforesting calls to %s and %s\n", [s(PredName1), s(PredName2)], !IO) ), call_call(ConjNonLocals, EarlierGoal, BetweenGoals, yes(LaterGoal), MaybeGoal, !PDInfo), ( MaybeGoal = yes(Goal), Optimized0 = yes, Goals = [Goal] ; MaybeGoal = no, Optimized0 = no, Goals = [] ) else if % If the first goal is branched and the second goal is a call, % attempt to push the call into the branches. Don't push a % recursive call or a call to a predicate we have already pushed % into a switch, since it is difficult to stop the process. EarlierGoal = hlds_goal(EarlierGoalExpr, _), goal_util.goal_is_branched(EarlierGoalExpr), LaterGoal = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _), PredProcId = proc(PredId, ProcId), PredProcId \= CurrPredProcId, not set.member(PredProcId, Parents0) then CurrPredName = predicate_name(ModuleInfo, PredId), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "Pushing call to %s into goal\n", [s(CurrPredName)], !IO) ), set.insert(proc(PredId, ProcId), Parents0, Parents), pd_info_set_parents(Parents, !PDInfo), push_goal_into_goal(ConjNonLocals, DeforestBranches, EarlierGoal, BetweenGoals, LaterGoal, Goal, !PDInfo), Goals = [Goal], Optimized0 = yes else if % If both goals are branched, push the second into the branches % of the first. EarlierGoal = hlds_goal(EarlierGoalExpr, _), LaterGoal = hlds_goal(LaterGoalExpr, _), goal_util.goal_is_branched(EarlierGoalExpr), goal_util.goal_is_branched(LaterGoalExpr) then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "Pushing goal into goal\n", [], !IO) ), push_goal_into_goal(ConjNonLocals, DeforestBranches, EarlierGoal, BetweenGoals, LaterGoal, Goal, !PDInfo), Goals = [Goal], goals_size([EarlierGoal | BetweenGoals], ConjSize1), goal_size(LaterGoal, ConjSize2), goal_size(Goal, NewSize), SizeDiff = NewSize - ConjSize1 - ConjSize2, pd_info_incr_size_delta(SizeDiff, !PDInfo), Optimized0 = yes else trace [io(!IO)] ( pd_debug_message(!.PDInfo, "not optimizing\n", [], !IO) ), Goals = [], Optimized0 = no ) ), Optimized = is_improvement_worth_while(!.PDInfo, Optimized0, CostDelta0, SizeDelta0), % Clean up. pd_info_set_depth(Depth0, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo), ( Optimized = no, % XXX Currently this only attempts to deforest the first goal % with the first matching goal later in the conjunction. If the % deforestation failed, other later goals should be tried. % % Return everything to the state it was in before the attempted % optimization. pd_info_set_cost_delta(CostDelta0, !PDInfo), pd_info_set_size_delta(SizeDelta0, !PDInfo), % Remove any versions which were created. pd_info_get_created_versions(!.PDInfo, CreatedVersions), set.difference(CreatedVersions, CreatedVersions0, NewVersions0), set.to_sorted_list(NewVersions0, NewVersions), list.foldl(pd_info_remove_version, NewVersions, !PDInfo) % AfterGoals will be restored properly in conj. ; Optimized = yes, % We want to reprocess the deforested goal to see if it can be % deforested with other goals later in the conjunction. list.condense([BeforeIrrelevant, Goals, AfterIrrelevant], GoalsToProcess), compute_goal_infos(GoalsToProcess, GoalsAndInfo, !PDInfo), list.append(GoalsAndInfo, !AfterGoals), pd_info_set_instmap(InstMap0, !PDInfo), pd_info_set_changed(yes, !PDInfo), pd_info_set_rerun_det(yes, !PDInfo) ), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "finished deforestation at depth %i\n", [i(Depth0)], !IO) ), pd_info_set_parents(Parents0, !PDInfo). % Check whether deforestation is legal and worthwhile. % :- pred should_try_deforestation(deforest_info::in, bool::out, pd_info::in, pd_info::out) is det. should_try_deforestation(DeforestInfo, ShouldTry, !PDInfo) :- DeforestInfo = deforest_info(EarlierGoal, EarlierBranchInfo, BetweenGoals, LaterGoal, _, _), pd_info_get_useless_versions(!.PDInfo, UselessVersions), ( if EarlierGoal = hlds_goal(plain_call(PredId1, ProcId1, _, _, _, _), _), LaterGoal = hlds_goal(plain_call(PredId2, ProcId2, _, _, _, _), _), set.member(proc(PredId1, ProcId1) - proc(PredId2, ProcId2), UselessVersions) then trace [compile_time(flag("debug_deforest")), io(!IO)] ( pd_debug_message(!.PDInfo, "version tried before, not worthwhile\n", [], !IO) ), ShouldTry = no else if % If some later goal depends on a variable such as an io.state % for which the construction cannot be reversed, recursive % folding will be impossible, so give up on the optimization. EarlierBranchInfo = pd_branch_info(_, _, OpaqueVars), ( list.member(OpaqueGoal, BetweenGoals) ; OpaqueGoal = LaterGoal ), OpaqueGoal = hlds_goal(_, OpaqueGoalInfo), OpaqueNonLocals = goal_info_get_nonlocals(OpaqueGoalInfo), OpaqueVarsSet = set_of_var.set_to_bitset(OpaqueVars), set_of_var.intersect(OpaqueNonLocals, OpaqueVarsSet, UsedOpaqueVars), set_of_var.is_non_empty(UsedOpaqueVars) then trace [compile_time(flag("debug_deforest")), io(!IO)] ( pd_debug_message(!.PDInfo, "later goals depend on opaque vars\n", [], !IO) ), ShouldTry = no else if % A disjunction can be semidet only if it binds no variables. % If we push a goal which binds a variable into a semidet disjunction, % it won't be semidet anymore. % % We assume that LaterGoal can bind variables, because we don't know % whether it can or not. Its instmap_delta doesn't tell us, because % it tells us only the NEW inst of the variables whose insts it % changes. Without knowing their old insts as well, we don't know % whether the inst change reflects the variable being bound, or just % the gathering of knowledge about what its initial value could have % been. EarlierGoal = hlds_goal(disj(_), EarlierGoalInfo), EarlierGoalDetism = goal_info_get_determinism(EarlierGoalInfo), determinism_components(EarlierGoalDetism, _, EarlierGoalMaxSolns), EarlierGoalMaxSolns \= at_most_many then ShouldTry = no else ShouldTry = yes ). :- pred can_optimize_conj(hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in, bool::out, pd_info::in, pd_info::out) is det. can_optimize_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, ShouldTry, !PDInfo) :- pd_info_get_depth(!.PDInfo, Depth0), pd_info_get_module_info(!.PDInfo, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), globals.get_opt_tuple(Globals, OptTuple), MaxDepth = OptTuple ^ ot_deforestation_depth_limit, Depth = Depth0 + 1, pd_info_set_depth(Depth, !PDInfo), SizeLimit = OptTuple ^ ot_deforestation_size_threshold, globals.lookup_option(Globals, fully_strict, FullyStrictOp), ( if MaxDepth \= -1, % no depth limit set % XXX The *default* value of the depth_limit is 4, % so -1 does NOT mean that there is no depth limit set. Depth0 >= MaxDepth then % The depth limit was exceeded. This should not occur too often in % practice - the depth limit is just a safety net. trace [compile_time(flag("debug_deforest")), io(!IO)] ( pd_debug_message(!.PDInfo, "\n\n*****Depth limit exceeded*****\n\n", [], !IO) ), ShouldTry = no else if % Check whether either of the goals to be deforested is too large. % XXX This is probably a bit too crude, especially for LaterGoal, % which should be reduced in size in the specialized version % (the specialized version will only include one branch of the % top-level switch). SizeLimit \= -1, ( EarlierGoal = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _) ; MaybeLaterGoal = yes( hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _)) ), module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, CalledProcInfo), proc_info_get_goal(CalledProcInfo, CalledGoal), goal_size(CalledGoal, CalledGoalSize), SizeLimit \= -1, CalledGoalSize > SizeLimit then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "goal too large\n", [], !IO) ), ShouldTry = no else if % Check whether either of the goals to be deforested can't be inlined. ( EarlierGoal = hlds_goal(EarlierGoalExpr, _), EarlierGoalExpr = plain_call(PredId, ProcId, _, BuiltinState, _, _) ; MaybeLaterGoal = yes(hlds_goal(LaterGoalExpr, _)), LaterGoalExpr = plain_call(PredId, ProcId, _, BuiltinState, _, _) ), % We don't attempt to deforest predicates which have purity promises % because the extra impurity propagated through the goal when such % predicates are inlined will defeat any attempt at deforestation. % XXX We should probably allow deforestation of semipure goals. not inlining.can_inline_proc(ModuleInfo, PredId, ProcId, BuiltinState, may_not_inline_purity_promised_pred) then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "non-inlineable calls\n", [], !IO) ), ShouldTry = no else if % % Don't optimize if that would require duplicating % branched goal structures. % not is_simple_goal_list(BetweenGoals) then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "between goals not simple enough\n", [], !IO) ), ShouldTry = no else if % Give up if there are any impure goals involved. % XXX We should probably allow deforestation of semipure goals. ( list.member(ImpureGoal, BetweenGoals) ; ImpureGoal = EarlierGoal ; MaybeLaterGoal = yes(ImpureGoal) ), ImpureGoal = hlds_goal(_, ImpureGoalInfo), not goal_info_get_purity(ImpureGoalInfo) = purity_pure then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "goal list contains impure goal(s)\n", [], !IO) ), ShouldTry = no else if % Check whether interleaving the execution of the goals could alter % the termination behaviour in a way which is illegal according to the % semantics options. % FullyStrictOp = bool(FullyStrict), ( list.member(OtherGoal, BetweenGoals) ; MaybeLaterGoal = yes(LaterGoal), OtherGoal = LaterGoal ), not goal_util.reordering_maintains_termination_old(ModuleInfo, FullyStrict, EarlierGoal, OtherGoal) then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "interleaving execution could change termination behaviour\n", [], !IO) ), ShouldTry = no else ShouldTry = yes ). % Check that the code size increase is justified by the estimated % performance increase. This should err towards allowing optimization % - without any check at all the code size of the library only increases % ~10%. % :- func is_improvement_worth_while(pd_info, bool, int, int) = bool. is_improvement_worth_while(PDInfo, Optimized0, CostDelta0, SizeDelta0) = Optimized :- pd_info_get_cost_delta(PDInfo, CostDelta), pd_info_get_size_delta(PDInfo, SizeDelta), Improvement = CostDelta - CostDelta0, SizeDifference = SizeDelta - SizeDelta0, pd_info_get_module_info(PDInfo, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), globals.get_opt_tuple(Globals, OptTuple), Factor = OptTuple ^ ot_deforestation_cost_factor, ( if Optimized0 = yes, check_deforestation_improvement(Factor, Improvement, SizeDifference) then Optimized = yes, trace [io(!IO)] ( pd_debug_message(PDInfo, "Enough improvement: cost(%i) size(%i)\n", [i(Improvement), i(SizeDifference)], !IO) ) else Optimized = no, trace [io(!IO)] ( pd_debug_message(PDInfo, "Not enough improvement: cost(%i) size(%i)\n", [i(Improvement), i(SizeDifference)], !IO) ) ). %-----------------------------------------------------------------------------% % Attempt deforestation on a pair of calls. % :- pred call_call(set_of_progvar::in, hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in, maybe(hlds_goal)::out, pd_info::in, pd_info::out) is det. call_call(ConjNonLocals, EarlierGoal, BetweenGoals, MaybeLaterGoal, MaybeGoal, !PDInfo) :- can_optimize_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, ShouldTry, !PDInfo), ( ShouldTry = yes, disable_warning [suspicious_recursion] ( call_call(ConjNonLocals, EarlierGoal, BetweenGoals, MaybeLaterGoal, MaybeGoal, !PDInfo) ) ; ShouldTry = no, MaybeGoal = no ). % Attempt deforestation on a pair of calls. % :- pred call_call_2(set_of_progvar::in, hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in, maybe(hlds_goal)::out, pd_info::in, pd_info::out) is det. :- pragma consider_used(pred(call_call_2/7)). call_call_2(ConjNonLocals, EarlierGoal, BetweenGoals, MaybeLaterGoal, MaybeGoal, !PDInfo) :- create_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, ConjNonLocals, FoldGoal), pd_info_search_version(!.PDInfo, FoldGoal, MaybeVersion), pd_info_get_parent_versions(!.PDInfo, Parents), pd_info_get_module_info(!.PDInfo, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), globals.lookup_bool_option(Globals, debug_pd, DebugPD), ( if MaybeVersion = version(_, VersionPredProcId, VersionInfo, Renaming, TypeRenaming) then % If we see an opportunity to fold, take it. VersionPredProcId = proc(VersionPredId, _), pd_info_get_module_info(!.PDInfo, ModuleInfo0), FoldPredName = predicate_name(ModuleInfo0, VersionPredId), trace [io(!IO)] ( ( DebugPD = no ; DebugPD = yes, module_info_get_name(ModuleInfo, ModuleName), get_debug_output_stream(Globals, ModuleName, Stream, !IO), io.format(Stream, "Folded with %s\n", [s(FoldPredName)], !IO) ) ), ( if set.member(VersionPredProcId, Parents) then FoldCostDelta = cost_of_recursive_fold else FoldCostDelta = cost_of_fold ), pd_info_incr_cost_delta(FoldCostDelta, !PDInfo), goals_size([EarlierGoal | BetweenGoals], NegSizeDelta), SizeDelta = - NegSizeDelta, pd_info_incr_size_delta(SizeDelta, !PDInfo), create_call_goal(VersionPredProcId, VersionInfo, Renaming, TypeRenaming, Goal, !PDInfo), MaybeGoal = yes(Goal) else pd_info_get_global_term_info(!.PDInfo, TermInfo0), pd_info_get_parent_versions(!.PDInfo, ParentVersions0), trace [io(!IO)] ( ( DebugPD = no ; DebugPD = yes, module_info_get_name(ModuleInfo, ModuleName), get_debug_output_stream(Globals, ModuleName, Stream, !IO), io.write_string(Stream, "Parents: ", !IO), io.write_line(Stream, ParentVersions0, !IO), io.flush_output(Stream, !IO) ) ), pd_info_get_versions(!.PDInfo, Versions), pd_info_get_instmap(!.PDInfo, InstMap), pd_term.global_check(ModuleInfo, EarlierGoal, BetweenGoals, MaybeLaterGoal, InstMap, Versions, TermInfo0, TermInfo, CheckResult), ( CheckResult = ok(ProcPair, Size), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "global termination check succeeded - " ++ "creating new version\n", [], !IO) ), pd_info_set_global_term_info(TermInfo, !PDInfo), RunModes = no, MaybeGeneralised = no, create_deforest_goal(EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals, RunModes, ProcPair, Size, MaybeGeneralised, MaybeGoal, !PDInfo) ; CheckResult = possible_loop(ProcPair, Size, CoveringPredProcId), % The termination check found the same pair of end-points with the % same length goal. If the goal matches the goal for the "covering" % predicate, perform a most specific generalisation on the insts % then keep on going. try_generalisation(EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals, ProcPair, Size, CoveringPredProcId, MaybeGoal, !PDInfo) ; CheckResult = loop, trace [io(!IO)] ( pd_debug_message(!.PDInfo, "global termination check failed\n", [], !IO) ), MaybeGoal = no ), pd_info_set_global_term_info(TermInfo0, !PDInfo) ). %-----------------------------------------------------------------------------% % Create a new procedure for a conjunction to be deforested, then % recursively process that procedure. % :- pred create_deforest_goal(hlds_goal::in, hlds_goals::in, maybe(hlds_goal)::in, hlds_goal::in, set_of_progvar::in, bool::in, proc_pair::in, int::in, maybe(pred_proc_id)::in, maybe(hlds_goal)::out, pd_info::in, pd_info::out) is det. create_deforest_goal(EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal0, NonLocals, RunModes, ProcPair, Size, MaybeGeneralised, MaybeCallGoal, !PDInfo) :- pd_info_get_module_info(!.PDInfo, ModuleInfo0), module_info_get_globals(ModuleInfo0, Globals), globals.get_opt_tuple(Globals, OptTuple), VarsThreshold = OptTuple ^ ot_deforestation_vars_threshold, ( if EarlierGoal = hlds_goal(EarlierGoalExpr, _), EarlierGoalExpr = plain_call(PredId1, ProcId1, Args1, _, _, _), ( % No threshold set. VarsThreshold = -1 % XXX The *default* value of the vars threshold is 200, % so -1 does NOT mean that there is no threshold set. ; % Check that we are not creating a procedure with a massive number % of variables. We assume that all the variables in the first % called goal are present in the final version. If the number % of variables in the first called goal plus the number of % variables in BetweenGoals is less than % --deforestation-vars-threshold, go ahead and optimize. module_info_pred_proc_info(ModuleInfo0, PredId1, ProcId1, _, CalledProcInfo1), proc_info_get_goal(CalledProcInfo1, CalledGoal1), goal_util.goal_vars(CalledGoal1, GoalVars1), set_of_var.to_sorted_list(GoalVars1, GoalVarsList1), goal_util.goals_goal_vars(BetweenGoals, GoalVars2), set_of_var.to_sorted_list(GoalVars2, GoalVarsList2), list.length(GoalVarsList1, NumVars1), list.length(GoalVarsList2, NumVars2), NumVars = NumVars1 + NumVars2, NumVars < VarsThreshold ) then % Create the goal for the new predicate, unfolding the first call. pd_info_get_instmap(!.PDInfo, InstMap0), pd_info_get_proc_info(!.PDInfo, ProcInfo0), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "unfolding first call\n", [], !IO) ), unfold_call(no, no, PredId1, ProcId1, Args1, EarlierGoal, UnfoldedCall, DidUnfold, !PDInfo), create_conj(UnfoldedCall, BetweenGoals, MaybeLaterGoal, NonLocals, DeforestGoal0), set_of_var.to_sorted_list(NonLocals, NonLocalsList), ( if DidUnfold = yes, RunModes = yes then % If we did a generalisation step when creating this version, % we need to modecheck to propagate through the new insts. % If this causes mode errors, don't create the new version. % This can happen if a procedure expected an input to be bound % to a particular functor but the extra information was % generalised away. trace [io(!IO)] ( pd_debug_message(!.PDInfo, "running modes on deforest goal\n", [], !IO) ), pd_util.unique_modecheck_goal(DeforestGoal0, DeforestGoal, Errors1, !PDInfo), pd_util.unique_modecheck_goal(FoldGoal0, FoldGoal, Errors2, !PDInfo), Errors = Errors1 ++ Errors2 else DeforestGoal = DeforestGoal0, FoldGoal = FoldGoal0, Errors = [] ), % We must have been able to unfold the first call to proceed % with the optimization, otherwise we will introduce an % infinite loop in the generated code. ( if DidUnfold = yes, Errors = [] then % Create the new version. pd_info_define_new_pred(DeforestGoal, PredProcId, CallGoal, !PDInfo), PredProcId = proc(PredId, _), pd_info_get_module_info(!.PDInfo, ModuleInfo), PredName = predicate_name(ModuleInfo, PredId), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "\nCreated predicate %s\n", [s(PredName)], !IO) ), ( if MaybeLaterGoal = yes(hlds_goal(LaterGoalExpr, _)), LaterGoalExpr = plain_call(PredId2, ProcId2, _, _, _, _) then CalledPreds = [proc(PredId1, ProcId1), proc(PredId2, ProcId2)] else CalledPreds = [proc(PredId1, ProcId1)] ), pd_info_get_parent_versions(!.PDInfo, Parents0), pd_info_get_proc_info(!.PDInfo, ProcInfo1), proc_info_get_var_table(ProcInfo1, VarTable), lookup_var_types(VarTable, NonLocalsList, ArgTypes), VersionInfo = version_info(FoldGoal, CalledPreds, NonLocalsList, ArgTypes, InstMap0, 0, 0, Parents0, MaybeGeneralised), pd_info_get_global_term_info(!.PDInfo, TermInfo0), pd_term.update_global_term_info(ProcPair, PredProcId, Size, TermInfo0, TermInfo), pd_info_set_global_term_info(TermInfo, !PDInfo), set.insert_list([PredProcId | CalledPreds], Parents0, Parents), pd_info_set_parent_versions(Parents, !PDInfo), pd_info_register_version(PredProcId, VersionInfo, !PDInfo), % Run deforestation on the new predicate to do the folding. pd_info_get_unfold_info(!.PDInfo, UnfoldInfo), deforest_proc_deltas(PredProcId, CostDelta, SizeDelta, !PDInfo), pd_info_set_unfold_info(UnfoldInfo, !PDInfo), pd_info_incr_cost_delta(CostDelta, !PDInfo), pd_info_incr_size_delta(SizeDelta, !PDInfo), pd_info_set_parent_versions(Parents0, !PDInfo), pd_info_get_progress_stream(!.PDInfo, ProgressStream), pd_info_get_pred_proc_id(!.PDInfo, CurPredProcId), trace [io(!IO)] ( maybe_write_proc_progress_message(ProgressStream, ModuleInfo, "Back in", CurPredProcId, !IO) ), MaybeCallGoal = yes(CallGoal) else trace [io(!IO)] ( pd_debug_message(!.PDInfo, "Generalisation produced mode errors\n", [], !IO) ), MaybeCallGoal = no ), % The var_table field was updated when we unfolded the first call, % but all the new variables are only used in the new version, % so it is safe to reset the proc_info. pd_info_set_proc_info(ProcInfo0, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo) else trace [io(!IO)] ( pd_debug_message(!.PDInfo, "vars threshold exceeded\n", [], !IO) ), MaybeCallGoal = no ). %-----------------------------------------------------------------------------% % Create a goal to call a newly created version. % :- pred create_call_goal(pred_proc_id::in, version_info::in, map(prog_var, prog_var)::in, tsubst::in, hlds_goal::out, pd_info::in, pd_info::out) is det. create_call_goal(proc(PredId, ProcId), VersionInfo, Renaming, TypeSubn, Goal, !PDInfo) :- OldArgs = VersionInfo ^ version_arg_vars, pd_info_get_module_info(!.PDInfo, ModuleInfo), module_info_pred_proc_info(ModuleInfo, PredId, ProcId, CalledPredInfo, CalledProcInfo), pred_info_get_arg_types(CalledPredInfo, CalledTVarSet, _CalledExistQVars, ArgTypes0), % Rename the arguments in the version. pd_info_get_proc_info(!.PDInfo, ProcInfo0), pd_info_get_pred_info(!.PDInfo, PredInfo0), proc_info_get_var_table(ProcInfo0, VarTable0), pred_info_get_typevarset(PredInfo0, TVarSet0), % Rename the argument types using the current pred's tvarset. tvarset_merge_renaming(TVarSet0, CalledTVarSet, TVarSet, TypeRenaming), pred_info_set_typevarset(TVarSet, PredInfo0, PredInfo), pd_info_set_pred_info(PredInfo, !PDInfo), apply_variable_renaming_to_type_list(TypeRenaming, ArgTypes0, ArgTypes1), create_deforest_call_args(ModuleInfo, Renaming, TypeSubn, OldArgs, ArgTypes1, Args, VarTable0, VarTable), proc_info_set_var_table(VarTable, ProcInfo0, ProcInfo), pd_info_set_proc_info(ProcInfo, !PDInfo), % Compute a goal_info. proc_info_get_argmodes(CalledProcInfo, ArgModes), instmap_delta_from_mode_list(ModuleInfo, Args, ArgModes, InstMapDelta), proc_info_interface_determinism(ProcInfo, Detism), set_of_var.list_to_set(Args, NonLocals), pred_info_get_purity(CalledPredInfo, Purity), goal_info_init(NonLocals, InstMapDelta, Detism, Purity, GoalInfo), PredModule = pred_info_module(CalledPredInfo), PredName = pred_info_name(CalledPredInfo), GoalExpr = plain_call(PredId, ProcId, Args, not_builtin, no, qualified(PredModule, PredName)), Goal = hlds_goal(GoalExpr, GoalInfo). :- pred create_deforest_call_args(module_info::in, map(prog_var, prog_var)::in, tsubst::in, list(prog_var)::in, list(mer_type)::in, list(prog_var)::out, var_table::in, var_table::out) is det. create_deforest_call_args(_, _, _, [], [], [], !VarTable). create_deforest_call_args(_, _, _, [], [_ | _], _, !VarTable) :- unexpected($pred, "length mismatch"). create_deforest_call_args(_, _, _, [_ | _], [], _, !VarTable) :- unexpected($pred, "length mismatch"). create_deforest_call_args(ModuleInfo, Renaming, TypeSubn, [OldArg | OldArgs], [ArgType | ArgTypes], [Arg | Args], !VarTable) :- ( if map.search(Renaming, OldArg, ArgPrime) then Arg = ArgPrime else % The variable is local to the call. Create a fresh variable. apply_subst_to_type(TypeSubn, ArgType, SubnArgType), IsDummy = is_type_a_dummy(ModuleInfo, SubnArgType), ArgEntry = vte("", SubnArgType, IsDummy), add_var_entry(ArgEntry, Arg, !VarTable) ), create_deforest_call_args(ModuleInfo, Renaming, TypeSubn, OldArgs, ArgTypes, Args, !VarTable). %-----------------------------------------------------------------------------% % Combine the two goals to be deforested and the goals in between % into a conjunction. % :- pred create_conj(hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in, set_of_progvar::in, hlds_goal::out) is det. create_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, NonLocals, FoldGoal) :- ( MaybeLaterGoal = yes(LaterGoal), list.append([EarlierGoal | BetweenGoals], [LaterGoal], DeforestConj) ; MaybeLaterGoal = no, DeforestConj = [EarlierGoal | BetweenGoals] ), goal_list_determinism(DeforestConj, Detism), goal_list_instmap_delta(DeforestConj, InstMapDelta0), instmap_delta_restrict(NonLocals, InstMapDelta0, InstMapDelta), goal_list_purity(DeforestConj, Purity), goal_info_init(NonLocals, InstMapDelta, Detism, Purity, ConjInfo0), % Give the conjunction a context so that the generated predicate % name points to the location of the first goal. EarlierGoal = hlds_goal(_, EarlierGoalInfo), EarlierContext = goal_info_get_context(EarlierGoalInfo), goal_info_set_context(EarlierContext, ConjInfo0, ConjInfo), FoldGoal = hlds_goal(conj(plain_conj, DeforestConj), ConjInfo). %-----------------------------------------------------------------------------% % "Round-off" some of the extra information that caused the termination % check to fail and/or the insts of the versions not to match in an attempt % to achieve folding. % :- pred try_generalisation(hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in, hlds_goal::in, set_of_progvar::in, proc_pair::in, int::in, pred_proc_id::in, maybe(hlds_goal)::out, pd_info::in, pd_info::out) is det. try_generalisation(EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals, ProcPair, Size, CoveringPredProcId, MaybeGoal, !PDInfo) :- pd_info_get_module_info(!.PDInfo, ModuleInfo), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "trying generalisation\n", [], !IO) ), pd_info_get_versions(!.PDInfo, VersionIndex), map.lookup(VersionIndex, CoveringPredProcId, Version), Version = version_info(VersionGoal, _, VersionArgVars, VersionArgTypes, VersionInstMap, _, _, _, _), pd_info_get_versions(!.PDInfo, Versions), pd_info_get_proc_info(!.PDInfo, ProcInfo), proc_info_get_var_table(ProcInfo, VarTable), ( if pd_util.goals_match(ModuleInfo, VersionGoal, VersionArgVars, VersionArgTypes, FoldGoal, VarTable, Renaming, _) then do_generalisation(VersionArgVars, Renaming, VersionInstMap, EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals, ProcPair, Size, CoveringPredProcId, MaybeGoal, !PDInfo) else if % If the earlier goal is a generalisation of another version, try % matching against that. This happens when attempting two % deforestations in a row and the first deforestation required % generalisation. match_generalised_version(ModuleInfo, VersionGoal, VersionArgVars, VersionArgTypes, EarlierGoal, BetweenGoals, MaybeLaterGoal, ConjNonLocals, VarTable, Versions, Renaming) then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "matched with generalised version\n", [], !IO) ), do_generalisation(VersionArgVars, Renaming, VersionInstMap, EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals, ProcPair, Size, CoveringPredProcId, MaybeGoal, !PDInfo) else trace [io(!IO)] ( pd_debug_message(!.PDInfo, "goals don't match\n", [], !IO) ), MaybeGoal = no ). :- pred do_generalisation(list(prog_var)::in, map(prog_var, prog_var)::in, instmap::in, hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in, hlds_goal::in, set_of_progvar::in, proc_pair::in, int::in, pred_proc_id::in, maybe(hlds_goal)::out, pd_info::in, pd_info::out) is det. do_generalisation(VersionArgVars, Renaming, VersionInstMap, EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals, ProcPair, Size, Generalised, MaybeGoal, !PDInfo) :- pd_info_get_module_info(!.PDInfo, ModuleInfo), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "goals match, trying MSG\n", [], !IO) ), pd_info_get_instmap(!.PDInfo, InstMap0), instmap_lookup_vars(VersionInstMap, VersionArgVars, VersionInsts), pd_util.inst_list_size(ModuleInfo, VersionInsts, VersionInstSizes), set_of_var.to_sorted_list(ConjNonLocals, ConjNonLocalsList), ( if % Check whether we can do a most specific generalisation of insts % of the non-locals. try_MSG(ModuleInfo, VersionInstMap, Renaming, VersionArgVars, InstMap0, InstMap), instmap_lookup_vars(InstMap, ConjNonLocalsList, ArgInsts), pd_util.inst_list_size(ModuleInfo, ArgInsts, NewInstSizes), NewInstSizes < VersionInstSizes then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "MSG succeeded", [], !IO) ), pd_info_set_instmap(InstMap, !PDInfo), create_deforest_goal(EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals, yes, ProcPair, Size, yes(Generalised), MaybeGoal, !PDInfo) else trace [io(!IO)] ( pd_debug_message(!.PDInfo, "MSG failed\n", [], !IO) ), MaybeGoal = no ), pd_info_set_instmap(InstMap0, !PDInfo). :- pred try_MSG(module_info::in, instmap::in, map(prog_var, prog_var)::in, list(prog_var)::in, instmap::in, instmap::out) is semidet. try_MSG(_, _, _, [], !InstMap). try_MSG(ModuleInfo, VersionInstMap, Renaming, [VersionArgVar | VersionArgVars], !InstMap) :- instmap_lookup_var(VersionInstMap, VersionArgVar, VersionInst), ( if map.search(Renaming, VersionArgVar, ArgVar), instmap_lookup_var(!.InstMap, ArgVar, VarInst), inst_MSG(ModuleInfo, VersionInst, VarInst, Inst) then instmap_set_var(ArgVar, Inst, !InstMap) else true ), try_MSG(ModuleInfo, VersionInstMap, Renaming, VersionArgVars, !InstMap). %-----------------------------------------------------------------------------% % If the global termination check and generalisation failed and % the first goal in the conjunction to be specialised is a generalisation % of another version, try matching and generalising using that % (non-generalised) version. % % This predicate maps the call to the generalised predicate back % onto the non-generalised version. This makes the goal match % with the previous conjunction, so the generalisation can be % reapplied to the entire conjunction. % % XXX This only undoes one level of generalisation. % :- pred match_generalised_version(module_info::in, hlds_goal::in, list(prog_var)::in, list(mer_type)::in, hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in, set_of_progvar::in, var_table::in, version_index::in, map(prog_var, prog_var)::out) is semidet. match_generalised_version(ModuleInfo, VersionGoal, VersionArgVars, VersionArgTypes, FirstGoal, BetweenGoals, MaybeLastGoal, ConjNonLocals, !.VarTable, Versions, Renaming) :- FirstGoal = hlds_goal(FirstGoalExpr, _), FirstGoalExpr = plain_call(FirstPredId, FirstProcId, FirstArgVars, _, _, _), % Look up the version which the first goal calls. map.search(Versions, proc(FirstPredId, FirstProcId), FirstVersionInfo), FirstVersionInfo = version_info(FirstVersionGoal, _, FirstVersionArgVars, _, _, _, _, _, MaybeNonGeneralisedVersion), MaybeNonGeneralisedVersion = yes(NonGeneralisedPredProcId), map.from_corresponding_lists(FirstVersionArgVars, FirstArgVars, FirstRenaming0), goal_util.goal_vars(FirstVersionGoal, FirstVersionVars0), set_of_var.to_sorted_list(FirstVersionVars0, FirstVersionVars), module_info_pred_proc_info(ModuleInfo, FirstPredId, FirstProcId, _, FirstProcInfo), proc_info_get_var_table(FirstProcInfo, FirstVersionVarTable), clone_variables(FirstVersionVars, FirstVersionVarTable, !VarTable, FirstRenaming0, FirstRenaming), must_rename_vars_in_goal(FirstRenaming, FirstVersionGoal, RenamedFirstVersionGoal), % Look up the version which was generalised to create the version % which the first goal calls. NonGeneralisedPredProcId = proc(NonGeneralisedPredId, NonGeneralisedProcId), goal_to_conj_list(VersionGoal, VersionGoalList), VersionGoalList = [hlds_goal( plain_call(NonGeneralisedPredId, NonGeneralisedProcId, _, _, _, _), _) | _], % Find a renaming from the argument variables of the generalised % version to the version which was generalised. map.search(Versions, NonGeneralisedPredProcId, NonGeneralisedVersion), NonGeneralisedVersion = version_info(NonGeneralisedGoal, _, NonGeneralisedArgVars, NonGeneralisedArgTypes,_,_,_,_,_), pd_util.goals_match(ModuleInfo, NonGeneralisedGoal, NonGeneralisedArgVars, NonGeneralisedArgTypes, RenamedFirstVersionGoal, !.VarTable, GeneralRenaming, TypeRenaming), module_info_pred_info(ModuleInfo, NonGeneralisedPredId, NonGeneralisedPredInfo), pred_info_get_arg_types(NonGeneralisedPredInfo, NonGeneralisedArgTypes), create_deforest_call_args(ModuleInfo, GeneralRenaming, TypeRenaming, NonGeneralisedArgVars, NonGeneralisedArgTypes, NewArgVars, !.VarTable, _), % Only fill in as much as pd_util.goals_match actually looks at. goal_info_init(GoalInfo), NonGeneralFirstGoalExpr = plain_call(NonGeneralisedPredId, NonGeneralisedProcId, NewArgVars, not_builtin, no, unqualified("")), NonGeneralFirstGoal = hlds_goal(NonGeneralFirstGoalExpr, GoalInfo), create_conj(NonGeneralFirstGoal, BetweenGoals, MaybeLastGoal, ConjNonLocals, GoalToMatch), % Check whether the entire conjunction matches. pd_util.goals_match(ModuleInfo, VersionGoal, VersionArgVars, VersionArgTypes, GoalToMatch, !.VarTable, Renaming, _). %-----------------------------------------------------------------------------% % Work out the nonlocals of a sub-conjunction from the non-locals of the % entire conjunction and the goals before and after the sub-conjunction. % This is needed to ensure that the temporary list in double_append is % found to be local to the conjunction and can be removed. % :- pred get_sub_conj_nonlocals(set_of_progvar::in, deforest_info::in, list(hlds_goal)::in, list(hlds_goal)::in, list(hlds_goal)::in, annotated_conj::in, set_of_progvar::out) is det. get_sub_conj_nonlocals(NonLocals0, DeforestInfo, RevBeforeGoals, BeforeIrrelevant, AfterIrrelevant, AfterGoals0, SubConjNonLocals) :- DeforestInfo = deforest_info(EarlierGoal, _, BetweenGoals, LaterGoal, _, _), assoc_list.keys(AfterGoals0, AfterGoals), do_get_sub_conj_nonlocals(NonLocals0, RevBeforeGoals, BeforeIrrelevant, EarlierGoal, BetweenGoals, yes(LaterGoal), AfterIrrelevant, AfterGoals, SubConjNonLocals). :- pred do_get_sub_conj_nonlocals(set_of_progvar::in, list(hlds_goal)::in, list(hlds_goal)::in, hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in, list(hlds_goal)::in, list(hlds_goal)::in, set_of_progvar::out) is det. do_get_sub_conj_nonlocals(!.NonLocals, RevBeforeGoals, BeforeIrrelevant, EarlierGoal, BetweenGoals, MaybeLaterGoal, AfterIrrelevant, AfterGoals, !:SubConjNonLocals) :- AddGoalNonLocals = ( pred(Goal::in, Vars0::in, Vars::out) is det :- Goal = hlds_goal(_, GoalInfo), GoalNonLocals = goal_info_get_nonlocals(GoalInfo), set_of_var.union(GoalNonLocals, Vars0, Vars) ), list.foldl(AddGoalNonLocals, RevBeforeGoals, !NonLocals), list.foldl(AddGoalNonLocals, BeforeIrrelevant, !NonLocals), list.foldl(AddGoalNonLocals, AfterIrrelevant, !NonLocals), list.foldl(AddGoalNonLocals, AfterGoals, !NonLocals), list.foldl(AddGoalNonLocals, [EarlierGoal | BetweenGoals], set_of_var.init, !:SubConjNonLocals), ( MaybeLaterGoal = yes(LaterGoal), call(AddGoalNonLocals, LaterGoal, !SubConjNonLocals) ; MaybeLaterGoal = no ), set_of_var.intersect(!.NonLocals, !SubConjNonLocals). %-----------------------------------------------------------------------------% % Attempt to move irrelevant goals out of the conjunction. This does a safe % re-ordering that is guaranteed not to require rescheduling of the % conjunction, since it does not reorder goals that depend on each other. % We favor moving goals backward to avoid removing tail recursion. % :- pred reorder_conj(deforest_info::in, deforest_info::out, list(hlds_goal)::out, list(hlds_goal)::out, pd_info::in) is det. reorder_conj(DeforestInfo0, DeforestInfo, BeforeIrrelevant, AfterIrrelevant, PDInfo) :- pd_info_get_module_info(PDInfo, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), trace [io(!IO)] ( pd_debug_message(PDInfo, "Reordering conjunction\n", [], !IO) ), DeforestInfo0 = deforest_info(EarlierGoal, EarlierBranchInfo, BetweenGoals0, LaterGoal, LaterBranchInfo, DeforestBranches), globals.lookup_bool_option(Globals, fully_strict, FullyStrict), move_goals(deforest.can_move_goal_backward, ModuleInfo, FullyStrict, BetweenGoals0, [], RevBetweenGoals1, EarlierGoal, [], RevBeforeIrrelevant), move_goals(deforest.can_move_goal_forward, ModuleInfo, FullyStrict, RevBetweenGoals1, [], BetweenGoals, LaterGoal, [], AfterIrrelevant), list.reverse(RevBeforeIrrelevant, BeforeIrrelevant), DeforestInfo = deforest_info(EarlierGoal, EarlierBranchInfo, BetweenGoals, LaterGoal, LaterBranchInfo, DeforestBranches). :- pred move_goals(can_move::can_move, module_info::in, bool::in, hlds_goals::in, hlds_goals::in, hlds_goals::out, hlds_goal::in, hlds_goals::in, hlds_goals::out) is det. move_goals(_, _, _, [], !BetweenGoals, _, !MovedGoal). move_goals(CanMove, ModuleInfo, FullyStrict, [BetweenGoal | RevBetweenGoals0], !BetweenGoals, EndGoal, !MovedGoals) :- ( if call(CanMove, ModuleInfo, FullyStrict, BetweenGoal, [EndGoal | !.BetweenGoals]) then !:MovedGoals = [BetweenGoal | !.MovedGoals] else !:BetweenGoals = [BetweenGoal | !.BetweenGoals] ), move_goals(CanMove, ModuleInfo, FullyStrict, RevBetweenGoals0, !BetweenGoals, EndGoal, !MovedGoals). :- type can_move == pred(module_info, bool, hlds_goal, hlds_goals). :- mode can_move == (pred(in, in, in, in) is semidet). % Check all goals occurring later in the conjunction to see if they depend % on the current goal. A goal depends on the current goal if any of the % non-locals of the later goal have their instantiatedness changed % by the current goal. % :- pred can_move_goal_forward(module_info::in, bool::in, hlds_goal::in, list(hlds_goal)::in) is semidet. can_move_goal_forward(ModuleInfo, FullyStrict, ThisGoal, Goals) :- ( list.member(LaterGoal, Goals) => pd_can_reorder_goals(ModuleInfo, FullyStrict, ThisGoal, LaterGoal) ). % Check all goals occurring earlier in the conjunction to see % if the current goal depends on them. % :- pred can_move_goal_backward(module_info::in, bool::in, hlds_goal::in, list(hlds_goal)::in) is semidet. can_move_goal_backward(ModuleInfo, FullyStrict, ThisGoal, Goals) :- ( list.member(EarlierGoal, Goals) => pd_can_reorder_goals(ModuleInfo, FullyStrict, EarlierGoal, ThisGoal) ). %-----------------------------------------------------------------------------% % Tack the second goal and the goals in between onto the end of each branch % of the first goal, unfolding the second goal in the branches which have % extra information about the arguments. % :- pred push_goal_into_goal(set_of_progvar::in, set(int)::in, hlds_goal::in, hlds_goals::in, hlds_goal::in, hlds_goal::out, pd_info::in, pd_info::out) is det. push_goal_into_goal(NonLocals, DeforestInfo, EarlierGoal, BetweenGoals, LaterGoal, Goal, !PDInfo) :- pd_info_get_instmap(!.PDInfo, InstMap0), EarlierGoal = hlds_goal(EarlierGoalExpr, _), ( EarlierGoalExpr = switch(Var1, CanFail1, Cases1), set_of_var.insert(Var1, NonLocals, CaseNonLocals), append_goal_to_cases(Var1, BetweenGoals, LaterGoal, CaseNonLocals, 1, DeforestInfo, Cases1, Cases, !PDInfo), GoalExpr = switch(Var1, CanFail1, Cases) ; EarlierGoalExpr = if_then_else(Vars, Cond, Then0, Else0), pd_info_update_goal(Cond, !PDInfo), Cond = hlds_goal(_, CondInfo), CondNonLocals = goal_info_get_nonlocals(CondInfo), set_of_var.union(CondNonLocals, NonLocals, ThenNonLocals), append_goal(Then0, BetweenGoals, LaterGoal, ThenNonLocals, 1, DeforestInfo, Then, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo), append_goal(Else0, BetweenGoals, LaterGoal, NonLocals, 2, DeforestInfo, Else, !PDInfo), GoalExpr = if_then_else(Vars, Cond, Then, Else) ; EarlierGoalExpr = disj(Disjuncts0), append_goal_to_disjuncts(BetweenGoals, LaterGoal, NonLocals, 1, DeforestInfo, Disjuncts0, Disjuncts, !PDInfo), GoalExpr = disj(Disjuncts) ; ( EarlierGoalExpr = unify(_, _, _, _, _) ; EarlierGoalExpr = plain_call(_, _, _, _, _, _) ; EarlierGoalExpr = generic_call(_, _, _, _, _) ; EarlierGoalExpr = call_foreign_proc(_, _, _, _, _, _, _) ; EarlierGoalExpr = conj(_, _) ; EarlierGoalExpr = negation(_) ; EarlierGoalExpr = scope(_, _) ; EarlierGoalExpr = shorthand(_) ), unexpected($pred, "unexpected goal type") ), pd_info_set_instmap(InstMap0, !PDInfo), goal_list_instmap_delta([EarlierGoal | BetweenGoals], Delta0), LaterGoal = hlds_goal(_, LaterInfo), Delta1 = goal_info_get_instmap_delta(LaterInfo), instmap_delta_apply_instmap_delta(Delta0, Delta1, test_size, Delta2), instmap_delta_restrict(NonLocals, Delta2, Delta), goal_list_determinism([EarlierGoal | BetweenGoals], Detism0), Detism1 = goal_info_get_determinism(LaterInfo), det_conjunction_detism(Detism0, Detism1, Detism), goal_list_purity([EarlierGoal | BetweenGoals], Purity0), Purity1 = goal_info_get_purity(LaterInfo), worst_purity(Purity0, Purity1) = Purity, goal_info_init(NonLocals, Delta, Detism, Purity, GoalInfo), Goal2 = hlds_goal(GoalExpr, GoalInfo), pd_info_get_module_info(!.PDInfo, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), find_simplify_tasks(Globals, do_not_generate_warnings, SimplifyTasks0), SimpList0 = simplify_tasks_to_list(SimplifyTasks0), % Be a bit more aggressive with common structure elimination. % This helps achieve folding in some cases. SimpList = [simptask_extra_common_structs | SimpList0], SimplifyTasks = list_to_simplify_tasks(Globals, SimpList), pd_util.pd_simplify_goal(SimplifyTasks, Goal2, Goal3, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo), % Perform any folding which may now be possible. deforest_goal(Goal3, Goal, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo). :- pred append_goal_to_disjuncts(hlds_goals::in, hlds_goal::in, set_of_progvar::in, int::in, set(int)::in, hlds_goals::in, hlds_goals::out, pd_info::in, pd_info::out) is det. append_goal_to_disjuncts(_, _, _, _, _, [], [], !PDInfo). append_goal_to_disjuncts(BetweenGoals, GoalToAppend, NonLocals, CurrBranch, Branches, [Goal0 | Goals0], [Goal | Goals], !PDInfo) :- pd_info_get_instmap(!.PDInfo, InstMap0), append_goal(Goal0, BetweenGoals, GoalToAppend, NonLocals, CurrBranch, Branches, Goal, !PDInfo), NextBranch = CurrBranch + 1, pd_info_set_instmap(InstMap0, !PDInfo), append_goal_to_disjuncts(BetweenGoals, GoalToAppend, NonLocals, NextBranch, Branches, Goals0, Goals, !PDInfo). :- pred append_goal_to_cases(prog_var::in, hlds_goals::in, hlds_goal::in, set_of_progvar::in, int::in, set(int)::in, list(case)::in,list(case)::out, pd_info::in, pd_info::out) is det. append_goal_to_cases(_, _, _, _, _, _, [], [], !PDInfo). append_goal_to_cases(Var, BetweenGoals, GoalToAppend, NonLocals, CurrCase, Branches, [Case0 | Cases0], [Case | Cases], !PDInfo) :- Case0 = case(MainConsId, OtherConsIds, Goal0), pd_info_get_instmap(!.PDInfo, InstMap0), pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo), append_goal(Goal0, BetweenGoals, GoalToAppend, NonLocals, CurrCase, Branches, Goal, !PDInfo), Case = case(MainConsId, OtherConsIds, Goal), NextCase = CurrCase + 1, pd_info_set_instmap(InstMap0, !PDInfo), append_goal_to_cases(Var, BetweenGoals, GoalToAppend, NonLocals, NextCase, Branches, Cases0, Cases, !PDInfo). :- pred append_goal(hlds_goal::in, hlds_goals::in, hlds_goal::in, set_of_progvar::in, int::in, set(int)::in, hlds_goal::out, pd_info::in, pd_info::out) is det. append_goal(Goal0, BetweenGoals, GoalToAppend0, NonLocals0, CurrBranch, Branches, Goal, !PDInfo) :- ( if set.member(CurrBranch, Branches) then % Unfold the call. pd_info_get_instmap(!.PDInfo, InstMap0), list.foldl(pd_info_update_goal, [Goal0 | BetweenGoals], !PDInfo), deforest_goal(GoalToAppend0, GoalToAppend, !PDInfo), pd_info_set_instmap(InstMap0, !PDInfo) else GoalToAppend = GoalToAppend0 ), goal_to_conj_list(Goal0, GoalList0), goal_to_conj_list(GoalToAppend, GoalListToAppend), list.condense([GoalList0, BetweenGoals, GoalListToAppend], Goals), goal_list_nonlocals(Goals, SubNonLocals), set_of_var.intersect(NonLocals0, SubNonLocals, NonLocals), goal_list_instmap_delta(Goals, Delta0), instmap_delta_restrict(NonLocals, Delta0, Delta), goal_list_determinism(Goals, Detism), goal_list_purity(Goals, Purity), goal_info_init(NonLocals, Delta, Detism, Purity, GoalInfo), Goal = hlds_goal(conj(plain_conj, Goals), GoalInfo). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- pred deforest_call(pred_id::in, proc_id::in, list(prog_var)::in, sym_name::in, builtin_state::in, hlds_goal::in, hlds_goal::out, pd_info::in, pd_info::out) is det. deforest_call(PredId, ProcId, Args, SymName, BuiltinState, Goal0, Goal, !PDInfo) :- pd_info_get_proc_arg_info(!.PDInfo, ProcArgInfos), pd_info_get_module_info(!.PDInfo, ModuleInfo), pd_info_get_instmap(!.PDInfo, InstMap), Name = unqualify_name(SymName), list.length(Args, Arity), Goal0 = hlds_goal(GoalExpr0, GoalInfo0), Context = goal_info_get_context(GoalInfo0), pd_info_get_local_term_info(!.PDInfo, LocalTermInfo0), module_info_get_globals(ModuleInfo, Globals), globals.get_opt_tuple(Globals, OptTuple), SizeThreshold = OptTuple ^ ot_deforestation_size_threshold, ( if % Check for extra information to the call. map.search(ProcArgInfos, proc(PredId, ProcId), ProcArgInfo), ProcArgInfo = pd_branch_info(_, LeftArgs, _), set.member(LeftArg, LeftArgs), list.det_index1(Args, LeftArg, Arg), instmap_lookup_var(InstMap, Arg, ArgInst), inst_is_bound_to_functors(ModuleInfo, ArgInst, [_]), % We don't attempt to deforest predicates which have purity promises % because the extra impurity propagated through the goal when such % predicates are inlined will defeat any attempt at deforestation. % XXX We should probably allow deforestation of semipure goals. inlining.can_inline_proc(ModuleInfo, PredId, ProcId, BuiltinState, may_not_inline_purity_promised_pred), % Check the goal size. module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, CalledProcInfo), proc_info_get_goal(CalledProcInfo, CalledGoal), goal_size(CalledGoal, CalledGoalSize), ( SizeThreshold = -1 ; CalledGoalSize < SizeThreshold ) then trace [io(!IO)] ( pd_debug_message_context(!.PDInfo, Context, "Found extra information for call to %s/%i\n", [s(Name), i(Arity)], !IO) ), ( if pd_term.local_check(ModuleInfo, Goal0, InstMap, LocalTermInfo0, LocalTermInfo) then trace [io(!IO)] ( pd_debug_message(!.PDInfo, "Local termination check succeeded\n", [], !IO) ), pd_info_set_local_term_info(LocalTermInfo, !PDInfo), unfold_call(yes, yes, PredId, ProcId, Args, Goal0, Goal1, Optimized, !PDInfo), ( Optimized = yes, deforest_goal(Goal1, Goal, !PDInfo) ; Optimized = no, Goal = Goal1 ), pd_info_set_local_term_info(LocalTermInfo0, !PDInfo) else trace [io(!IO)] ( pd_debug_message(!.PDInfo, "Local termination check failed\n", [], !IO) ), Goal = hlds_goal(GoalExpr0, GoalInfo0) ) else trace [io(!IO)] ( pd_debug_message_context(!.PDInfo, Context, "No extra information for call to %s/%i\n", [s(Name), i(Arity)], !IO) ), Goal = Goal0 ). :- pred unfold_call(bool::in, bool::in, pred_id::in, proc_id::in, list(prog_var)::in, hlds_goal::in, hlds_goal::out, bool::out, pd_info::in, pd_info::out) is det. unfold_call(CheckImprovement, CheckVars, PredId, ProcId, Args, Goal0, Goal, Optimized, !PDInfo) :- pd_info_get_module_info(!.PDInfo, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), globals.get_opt_tuple(Globals, OptTuple), VarsThreshold = OptTuple ^ ot_deforestation_vars_threshold, pd_info_get_proc_info(!.PDInfo, ProcInfo0), proc_info_get_var_table(ProcInfo0, VarTable0), var_table_count(VarTable0, NumVars), ( if % Check that we haven't already got too many variables. ( CheckVars = no ; VarsThreshold = -1 % XXX The *default* value of the vars threshold is 200, % so -1 does NOT mean that there is no threshold set. ; NumVars < VarsThreshold ) then pd_info_get_pred_info(!.PDInfo, PredInfo0), module_info_pred_proc_info(ModuleInfo, PredId, ProcId, CalledPredInfo, CalledProcInfo), pred_info_get_typevarset(PredInfo0, TypeVarSet0), pred_info_get_univ_quant_tvars(PredInfo0, UnivQVars), proc_info_get_rtti_varmaps(ProcInfo0, RttiVarMaps0), inlining.do_inline_call(ModuleInfo, UnivQVars, Args, CalledPredInfo, CalledProcInfo, TypeVarSet0, TypeVarSet, VarTable0, VarTable, RttiVarMaps0, RttiVarMaps, Goal1), pred_info_set_typevarset(TypeVarSet, PredInfo0, PredInfo), proc_info_get_has_parallel_conj(CalledProcInfo, CalledHasParallelConj), proc_info_set_var_table(VarTable, ProcInfo0, ProcInfo1), proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo1, ProcInfo2), ( CalledHasParallelConj = has_parallel_conj, proc_info_set_has_parallel_conj(has_parallel_conj, ProcInfo2, ProcInfo) ; CalledHasParallelConj = has_no_parallel_conj, % Leave the has_parallel_conj field of the proc_info as it is. ProcInfo = ProcInfo2 ), pd_info_set_pred_info(PredInfo, !PDInfo), pd_info_set_proc_info(ProcInfo, !PDInfo), goal_cost(Goal1, OriginalCost), pd_info_get_cost_delta(!.PDInfo, CostDelta0), pd_info_get_size_delta(!.PDInfo, SizeDelta0), pd_info_get_changed(!.PDInfo, Changed0), % Update the quantification if not all the output arguments are used. Goal1 = hlds_goal(_, GoalInfo1), NonLocals1 = goal_info_get_nonlocals(GoalInfo1), set_of_var.list_to_set(Args, NonLocals), ( if set_of_var.equal(NonLocals1, NonLocals) then Goal2 = Goal1 else pd_requantify_goal(NonLocals, Goal1, Goal2, !PDInfo) ), % Push the extra information from the call through the goal. trace [io(!IO)] ( pd_debug_message(!.PDInfo, "Running unique modes\n", [], !IO) ), proc_info_arglives(ModuleInfo, CalledProcInfo, ArgLives), get_live_vars(Args, ArgLives, LiveVars0), set_of_var.list_to_set(LiveVars0, LiveVars1), set_of_var.intersect(NonLocals, LiveVars1, LiveVars), pd_util.unique_modecheck_goal_live_vars(LiveVars, Goal2, Goal3, Errors, !PDInfo), ( Errors = [], Optimized0 = yes ; Errors = [_ | _], % This can happen because common.m does not maintain unique mode % correctness. This should eventually be fixed. Optimized0 = no ), trace [io(!IO)] ( pd_debug_message(!.PDInfo, "Running simplify\n", [], !IO) ), find_simplify_tasks(Globals, do_not_generate_warnings, SimplifyTasks), pd_util.pd_simplify_goal(SimplifyTasks, Goal3, Goal4, !PDInfo), pd_info_get_cost_delta(!.PDInfo, CostDelta1), CostDelta = CostDelta1 - CostDelta0, goal_size(Goal4, GoalSize), SizeDelta = GoalSize - cost_of_call, Factor = OptTuple ^ ot_deforestation_cost_factor, ( if Optimized0 = yes, ( CheckImprovement = no ; CheckImprovement = yes, % XXX Should this test Goal4? zs ( if is_simple_goal(Goal3) then true else check_improvement(Factor, GoalSize, OriginalCost, CostDelta) ) ) then Goal = Goal4, trace [io(!IO)] ( pd_debug_message(!.PDInfo, "inlined: cost(%i) size(%i)\n", [i(CostDelta), i(SizeDelta)], !IO) ), pd_info_incr_size_delta(SizeDelta, !PDInfo), pd_info_set_changed(yes, !PDInfo), Goal0 = hlds_goal(_, GoalInfo0), Det0 = goal_info_get_determinism(GoalInfo0), Goal = hlds_goal(_, GoalInfo), Det = goal_info_get_determinism(GoalInfo), % Rerun determinism analysis later if the determinism of any of % the sub-goals changes - this avoids problems with inlining % erroneous predicates. ( if Det = Det0 then true else pd_info_set_rerun_det(yes, !PDInfo) ), Optimized = yes else trace [io(!IO)] ( pd_debug_message(!.PDInfo, "not enough improvement - " ++ "not inlining: cost(%i) size(%i)\n", [i(CostDelta), i(SizeDelta)], !IO) ), pd_info_set_pred_info(PredInfo0, !PDInfo), pd_info_set_proc_info(ProcInfo0, !PDInfo), pd_info_set_size_delta(SizeDelta0, !PDInfo), pd_info_set_cost_delta(CostDelta0, !PDInfo), pd_info_set_changed(Changed0, !PDInfo), Goal = Goal0, Optimized = no ) else trace [io(!IO)] ( pd_debug_message(!.PDInfo, "too many variables - not inlining\n", [], !IO) ), Goal = Goal0, Optimized = no ). %-----------------------------------------------------------------------------% :- pred is_simple_goal_list(list(hlds_goal)::in) is semidet. is_simple_goal_list([]). is_simple_goal_list([Goal | Goals]) :- is_simple_goal(Goal), is_simple_goal_list(Goals). :- pred is_simple_goal(hlds_goal::in) is semidet. is_simple_goal(hlds_goal(GoalExpr, _)) :- ( goal_expr_has_subgoals(GoalExpr) = does_not_have_subgoals ; GoalExpr = negation(Goal1), % Handle a call or builtin + tests on the output. goal_to_conj_list(Goal1, GoalList1), is_simple_goal_list(GoalList1) ). %-----------------------------------------------------------------------------% % Very rough heuristics for checking improvement. This should lean % towards allowing optimizations. % :- pred check_improvement(int::in, int::in, int::in, int::in) is semidet. check_improvement(_Factor, Size, OriginalCost, CostDelta) :- ( if Size =< 5 then % For small increases in size, accept any amount of optimization. CostDelta > 0 else PercentChange = CostDelta * 100 // OriginalCost, PercentChange >= 5 ). :- pred check_deforestation_improvement(int::in, int::in, int::in) is semidet. check_deforestation_improvement(Factor, CostDelta, SizeChange) :- ( if SizeChange =< 5 then % For small increases in size, accept any amount of optimization. CostDelta > 0 else % Accept the optimization if we save the equivalent of a heap increment % per 3 extra atomic goals. Note that folding is heavily rewarded by % pd_cost.m, so this isn't very restrictive if a fold occurs. ExpectedCostDelta = 1000 * cost_of_heap_incr * SizeChange // 3, FudgedCostDelta = CostDelta * Factor, FudgedCostDelta >= ExpectedCostDelta ). %-----------------------------------------------------------------------------% :- end_module transform_hlds.deforest. %-----------------------------------------------------------------------------%