mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 13:23:53 +00:00
b56885be93
Estimated hours taken: 12 Branches: main Fix a bug that caused bootchecks with --optimize-constructor-last-call to fail. The problem was not in lco.m, but in follow_code.m. In some cases, (specifically, the LCMC version of insert_2 in sparse_bitset.m), follow_code.m moved an impure goal (store_at_ref) into the arms of an if-then-else without marking those arms, or the if-then-else, as impure. The next pass, simplify, then deleted the entire if-then-else, since it had no outputs. (The store_at_ref that originally appeared after the if-then-else was the only consumer of its only output.) The fix is to get follow_code.m to make branched control structures such as if-then-elses, as well as their arms, semipure or impure if a goal being moved into them is semipure or impure, or if they came from an semipure or impure conjunction. Improve the optimization of the LCMC version of sparse_bitset.insert_2, which had a foreign_proc invocation of bits_per_int in it: replace such invocations with a unification of the bits_per_int constant if not cross compiling. Add a new option, --optimize-constructor-last-call-null. When set, LCMC will assign NULLs to the fields not yet filled in, to avoid any junk happens to be there from being followed by the garbage collector's mark phase. This diff also makes several other changes that helped me to track down the bug above. compiler/follow_code.m: Make the fix described above. Delete all the provisions for --prev-code; it won't be implemented. Don't export a predicate that is not now used anywhere else. compiler/simplify.m: Make the optimization described above. compiler/lco.m: Make sure that the LCMC specialized procedure is a predicate, not a function: having a function with the mode LCMC_insert_2(in, in) = in looks wrong. To avoid name collisions when a function and a predicate with the same name and arity have LCMC applied to them, include the predicate vs function status of the original procedure included in the name of the new procedure. Update the sym_name of calls to LCMC variants, not just the pred_id, because without that, the HLDS dump looks misleading. compiler/pred_table.m: Don't have optimizations like LCMC insert new predicates at the front of the list of predicates. Maintain the list of predicates in the module as a two part list, to allow efficient addition of new pred_ids at the (logical) end without using O(N^2) algorithms. Having predicates in chronological order makes it easier to look at HLDS dumps and .c files. compiler/hlds_module.m: Make module_info_predids return a module_info that is physically updated though logically unchanged. compiler/options.m: Add --optimize-constructor-last-call-null. Make the options --dump-hlds-pred-id, --debug-opt-pred-id and --debug-opt-pred-name into accumulating options, to allow the user to specify more than one predicate to be dumped (e.g. insert_2 and its LCMC variant). Delete --prev-code. doc/user_guide.texi: Document the changes in options.m. compiler/code_info.m: Record the value of --optimize-constructor-last-call-null in the code_info, to avoid lookup at every cell construction. compiler/unify_gen.m: compiler/var_locn.m: When deciding whether a cell can be static or not, make sure that we never make static a cell that has some fields initialized with dummy zeros, to be filled in for real later. compiler/hlds_out.m: For goals that are semipure or impure, note this fact. This info was lost when I changed the representation of impurity from markers to a field. mdbcomp/prim_data.m: Rename some ambiguous function symbols. compiler/intermod.m: compiler/trans_opt.m: Rename the main predicates (and some function symbols) of these modules to avoid ambiguity and to make them more expressive. compiler/llds.m: Don't print line numbers for foreign_code fragments if the user has specified --no-line-numbers. compiler/make.dependencies.m: compiler/mercury_to_mercury.m: compiler/recompilation.usage.m: Don't use io.write to write out information to files we may need to parse again, because this is vulnerable to changes to the names of function symbols (e.g. the one to mdbcomp/prim_data.m). The compiler still contains some uses of io.write, but they are for debugging. I added an item to the todo list of the one exception, ilasm.m. compiler/recompilation.m: Rename a misleading function symbol name. compiler/parse_tree.m: Don't import recompilation.m here. It is not needed (all the components of parse_tree that need recompilation.m already import it themselves), and deleting the import avoids recompiling almost everything when recompilation.m changes. compiler/*.m: Conform to the changes above. compiler/*.m: browser/*.m: slice/*.m: Conform to the change to mdbcomp. library/sparse_bitset.m: Use some better variable names.
747 lines
29 KiB
Mathematica
747 lines
29 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1994-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: switch_detection.m.
|
|
% Main author: fjh.
|
|
%
|
|
% Switch detection - when a disjunction contains disjuncts that unify the
|
|
% same input variable with different function symbols, replace (part of)
|
|
% the disjunction with a switch.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module check_hlds.switch_detection.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module bool.
|
|
:- import_module io.
|
|
:- import_module list.
|
|
|
|
:- pred detect_switches(module_info::in, module_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pred detect_switches_in_proc(proc_id::in, pred_id::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
% find_bind_var(Var, ProcessUnify, Goal0, Goal, !Result, !Info,
|
|
% FoundDeconstruct):
|
|
%
|
|
% Used by both switch_detection and cse_detection. Searches through
|
|
% `Goal0' looking for the first deconstruction unification with `Var'
|
|
% or an alias of `Var'. If a deconstruction unification of the
|
|
% variable is found, `ProcessUnify' is called to handle it (which may
|
|
% replace the unification with some other goals, which is why we return
|
|
% Goal), and searching is stopped. If we don't find such a deconstruction,
|
|
% `!Result' is unchanged.
|
|
%
|
|
:- pred find_bind_var(prog_var::in,
|
|
process_unify(Result, Info)::in(process_unify),
|
|
hlds_goal::in, hlds_goal::out, Result::in, Result::out,
|
|
Info::in, Info::out, bool::out) is det.
|
|
|
|
:- type process_unify(Result, Info) ==
|
|
pred(prog_var, hlds_goal, list(hlds_goal), Result, Result, Info, Info).
|
|
:- inst process_unify == (pred(in, in, out, in, out, in, out) is det).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.det_util.
|
|
:- import_module check_hlds.inst_match.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.goal_util.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.instmap.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module hlds.quantification.
|
|
:- import_module libs.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_mode.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
:- import_module term.
|
|
:- import_module unit.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
detect_switches(!ModuleInfo, !IO) :-
|
|
% Traverse the module structure, calling `detect_switches_in_goal'
|
|
% for each procedure body.
|
|
module_info_predids(PredIds, !ModuleInfo),
|
|
detect_switches_in_preds(PredIds, !ModuleInfo, !IO).
|
|
|
|
:- pred detect_switches_in_preds(list(pred_id)::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
detect_switches_in_preds([], !ModuleInfo, !IO).
|
|
detect_switches_in_preds([PredId | PredIds], !ModuleInfo, !IO) :-
|
|
module_info_preds(!.ModuleInfo, PredTable),
|
|
map.lookup(PredTable, PredId, PredInfo),
|
|
detect_switches_in_pred(PredId, PredInfo, !ModuleInfo, !IO),
|
|
detect_switches_in_preds(PredIds, !ModuleInfo, !IO).
|
|
|
|
:- pred detect_switches_in_pred(pred_id::in, pred_info::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
detect_switches_in_pred(PredId, PredInfo0, !ModuleInfo, !IO) :-
|
|
ProcIds = pred_info_non_imported_procids(PredInfo0),
|
|
(
|
|
ProcIds = [_ | _],
|
|
write_pred_progress_message("% Detecting switches in ", PredId,
|
|
!.ModuleInfo, !IO),
|
|
detect_switches_in_procs(ProcIds, PredId, !ModuleInfo)
|
|
% This is where we should print statistics, if we ever need
|
|
% to debug the performance of switch detection.
|
|
;
|
|
ProcIds = []
|
|
).
|
|
|
|
:- pred detect_switches_in_procs(list(proc_id)::in, pred_id::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
detect_switches_in_procs([], _PredId, !ModuleInfo).
|
|
detect_switches_in_procs([ProcId | ProcIds], PredId, !ModuleInfo) :-
|
|
detect_switches_in_proc(ProcId, PredId, !ModuleInfo),
|
|
detect_switches_in_procs(ProcIds, PredId, !ModuleInfo).
|
|
|
|
detect_switches_in_proc(ProcId, PredId, !ModuleInfo) :-
|
|
module_info_preds(!.ModuleInfo, PredTable0),
|
|
map.lookup(PredTable0, PredId, PredInfo0),
|
|
pred_info_get_procedures(PredInfo0, ProcTable0),
|
|
map.lookup(ProcTable0, ProcId, ProcInfo0),
|
|
|
|
% To process each ProcInfo, we get the goal, initialize the instmap
|
|
% based on the modes of the head vars, and pass these to
|
|
% `detect_switches_in_goal'.
|
|
proc_info_get_goal(ProcInfo0, Goal0),
|
|
proc_info_get_vartypes(ProcInfo0, VarTypes),
|
|
proc_info_get_initial_instmap(ProcInfo0, !.ModuleInfo, InstMap0),
|
|
detect_switches_in_goal(!.ModuleInfo, VarTypes, InstMap0, Goal0, Goal,
|
|
no, Requant),
|
|
|
|
proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
|
|
(
|
|
Requant = yes,
|
|
requantify_proc(ProcInfo1, ProcInfo)
|
|
;
|
|
Requant = no,
|
|
ProcInfo = ProcInfo1
|
|
),
|
|
map.det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
|
|
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
|
|
map.det_update(PredTable0, PredId, PredInfo, PredTable),
|
|
module_info_set_preds(PredTable, !ModuleInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given a goal, and the instmap on entry to that goal,
|
|
% replace disjunctions with switches whereever possible.
|
|
%
|
|
:- pred detect_switches_in_goal(module_info::in, vartypes::in,
|
|
instmap::in, hlds_goal::in, hlds_goal::out, bool::in, bool::out) is det.
|
|
|
|
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0, !Goal, !Requant) :-
|
|
detect_switches_in_goal_1(ModuleInfo, VarTypes, InstMap0, _InstMap,
|
|
!Goal, !Requant).
|
|
|
|
% This version is the same as the above except that it returns the
|
|
% resulting instmap on exit from the goal, which is computed by applying
|
|
% the instmap delta specified in the goal's goalinfo.
|
|
%
|
|
:- pred detect_switches_in_goal_1(module_info::in, vartypes::in,
|
|
instmap::in, instmap::out, hlds_goal::in, hlds_goal::out,
|
|
bool::in, bool::out) is det.
|
|
|
|
detect_switches_in_goal_1(ModuleInfo, VarTypes, !InstMap,
|
|
Goal0, Goal, !Requant) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
|
|
detect_switches_in_goal_2(ModuleInfo, VarTypes, !.InstMap, GoalInfo,
|
|
GoalExpr0, GoalExpr, !Requant),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo),
|
|
update_instmap(Goal0, !InstMap).
|
|
|
|
% Here we process each of the different sorts of goals.
|
|
%
|
|
:- pred detect_switches_in_goal_2(module_info::in, vartypes::in, instmap::in,
|
|
hlds_goal_info::in, hlds_goal_expr::in, hlds_goal_expr::out,
|
|
bool::in, bool::out) is det.
|
|
|
|
detect_switches_in_goal_2(ModuleInfo, VarTypes, InstMap0, GoalInfo,
|
|
Goal0, Goal, !Requant) :-
|
|
(
|
|
Goal0 = disj(Goals0),
|
|
(
|
|
Goals0 = [],
|
|
Goal = disj([])
|
|
;
|
|
Goals0 = [_ | _],
|
|
goal_info_get_nonlocals(GoalInfo, NonLocals),
|
|
set.to_sorted_list(NonLocals, NonLocalsList),
|
|
detect_switches_in_disj(NonLocalsList, Goals0, GoalInfo, InstMap0,
|
|
VarTypes, NonLocalsList, ModuleInfo, [], Goal, !Requant)
|
|
)
|
|
;
|
|
Goal0 = conj(ConjType, Goals0),
|
|
detect_switches_in_conj(ModuleInfo, VarTypes, InstMap0,
|
|
Goals0, Goals, !Requant),
|
|
Goal = conj(ConjType, Goals)
|
|
;
|
|
Goal0 = negation(SubGoal0),
|
|
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0,
|
|
SubGoal0, SubGoal, !Requant),
|
|
Goal = negation(SubGoal)
|
|
;
|
|
Goal0 = if_then_else(Vars, Cond0, Then0, Else0),
|
|
detect_switches_in_goal_1(ModuleInfo, VarTypes, InstMap0, InstMap1,
|
|
Cond0, Cond, !Requant),
|
|
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap1, Then0, Then,
|
|
!Requant),
|
|
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0, Else0, Else,
|
|
!Requant),
|
|
Goal = if_then_else(Vars, Cond, Then, Else)
|
|
;
|
|
Goal0 = switch(Var, CanFail, Cases0),
|
|
detect_switches_in_cases(ModuleInfo, VarTypes, InstMap0,
|
|
Cases0, Cases, !Requant),
|
|
Goal = switch(Var, CanFail, Cases)
|
|
;
|
|
Goal0 = scope(Reason, SubGoal0),
|
|
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0,
|
|
SubGoal0, SubGoal, !Requant),
|
|
Goal = scope(Reason, SubGoal)
|
|
;
|
|
Goal0 = unify(_, RHS0, _, _, _),
|
|
( RHS0 = rhs_lambda_goal(_, _, _, _, Vars, Modes, _, LambdaGoal0) ->
|
|
% We need to insert the initial insts for the lambda variables
|
|
% in the instmap before processing the lambda goal.
|
|
instmap.pre_lambda_update(ModuleInfo, Vars, Modes,
|
|
InstMap0, InstMap1),
|
|
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap1,
|
|
LambdaGoal0, LambdaGoal, !Requant),
|
|
RHS = RHS0 ^ rhs_lambda_goal := LambdaGoal,
|
|
Goal = Goal0 ^ unify_rhs := RHS
|
|
;
|
|
Goal = Goal0
|
|
)
|
|
;
|
|
Goal0 = generic_call(_, _, _, _),
|
|
Goal = Goal0
|
|
;
|
|
Goal0 = plain_call(_, _, _, _, _, _),
|
|
Goal = Goal0
|
|
;
|
|
Goal0 = call_foreign_proc(_, _, _, _, _, _, _),
|
|
Goal = Goal0
|
|
;
|
|
Goal0 = shorthand(_),
|
|
% These should have been expanded out by now.
|
|
unexpected(this_file, "detect_switches_in_goal_2: shorthand")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type cases == map(cons_id, list(hlds_goal)).
|
|
|
|
:- type sorted_case_list == list(case).
|
|
% the sorted_case_list should always be sorted on cons_id -
|
|
% `delete_unreachable_cases' relies on this.
|
|
|
|
:- type again
|
|
---> again(prog_var, list(hlds_goal), sorted_case_list).
|
|
|
|
% This is the interesting bit - we've found a non-empty disjunction,
|
|
% and we've got a list of the non-local variables of that disjunction.
|
|
% Now for each non-local variable, we check whether there is a partition
|
|
% of the disjuncts such that each group of disjunctions can only succeed
|
|
% if the variable is bound to a different functor.
|
|
%
|
|
:- pred detect_switches_in_disj(list(prog_var)::in, list(hlds_goal)::in,
|
|
hlds_goal_info::in, instmap::in, vartypes::in,
|
|
list(prog_var)::in, module_info::in, list(again)::in,
|
|
hlds_goal_expr::out, bool::in, bool::out) is det.
|
|
|
|
detect_switches_in_disj([Var | Vars], Goals0, GoalInfo, InstMap,
|
|
VarTypes, AllVars, ModuleInfo, Again0, Goal, !Requant) :-
|
|
% Can we do at least a partial switch on this variable?
|
|
(
|
|
instmap.lookup_var(InstMap, Var, VarInst0),
|
|
inst_is_bound(ModuleInfo, VarInst0),
|
|
partition_disj(Goals0, Var, GoalInfo, Left, CasesList, !Requant)
|
|
->
|
|
% A switch needs to have at least two cases.
|
|
%
|
|
% But, if there is a complete one-case switch for a goal, we must leave
|
|
% it as a disjunction rather than doing an incomplete switch on a
|
|
% different variable, because otherwise we might get determinism
|
|
% analysis wrong. (The complete one-case switch may be decomposable
|
|
% into other complete sub-switches on the functor's arguments)
|
|
(
|
|
% Are there any disjuncts that are not part of the switch? No.
|
|
Left = [],
|
|
( CasesList = [_, _ | _] ->
|
|
cases_to_switch(CasesList, Var, VarTypes, GoalInfo, InstMap,
|
|
ModuleInfo, Goal, !Requant)
|
|
;
|
|
detect_sub_switches_in_disj(ModuleInfo, VarTypes, InstMap,
|
|
Goals0, Goals, !Requant),
|
|
Goal = disj(Goals)
|
|
)
|
|
;
|
|
% Are there any disjuncts that are not part of the switch? Yes.
|
|
Left = [_ | _],
|
|
% Insert this switch into the list of incomplete switches
|
|
% only if it has at least two cases.
|
|
( CasesList = [_, _ | _] ->
|
|
Again1 = [again(Var, Left, CasesList) | Again0]
|
|
;
|
|
Again1 = Again0
|
|
),
|
|
% Try to find a switch.
|
|
detect_switches_in_disj(Vars, Goals0, GoalInfo, InstMap, VarTypes,
|
|
AllVars, ModuleInfo, Again1, Goal, !Requant)
|
|
)
|
|
;
|
|
detect_switches_in_disj(Vars, Goals0, GoalInfo, InstMap,
|
|
VarTypes, AllVars, ModuleInfo, Again0, Goal, !Requant)
|
|
).
|
|
detect_switches_in_disj([], Goals0, GoalInfo, InstMap,
|
|
VarTypes, AllVars, ModuleInfo, AgainList0, disj(Goals), !Requant) :-
|
|
(
|
|
AgainList0 = [],
|
|
detect_sub_switches_in_disj(ModuleInfo, VarTypes, InstMap,
|
|
Goals0, Goals, !Requant)
|
|
;
|
|
AgainList0 = [Again | AgainList1],
|
|
select_best_switch(AgainList1, Again, BestAgain),
|
|
BestAgain = again(Var, Left0, CasesList),
|
|
cases_to_switch(CasesList, Var, VarTypes, GoalInfo, InstMap,
|
|
ModuleInfo, SwitchGoal, !Requant),
|
|
detect_switches_in_disj(AllVars, Left0, GoalInfo, InstMap,
|
|
VarTypes, AllVars, ModuleInfo, [], Left, !Requant),
|
|
goal_to_disj_list(hlds_goal(Left, GoalInfo), LeftList),
|
|
Goals = [hlds_goal(SwitchGoal, GoalInfo) | LeftList]
|
|
).
|
|
|
|
:- pred select_best_switch(list(again)::in, again::in, again::out) is det.
|
|
|
|
select_best_switch([], BestAgain, BestAgain).
|
|
select_best_switch([Again | AgainList], BestAgain0, BestAgain) :-
|
|
(
|
|
Again = again(_, _, CasesList),
|
|
BestAgain0 = again(_, _, BestCasesList),
|
|
list.length(CasesList, Length),
|
|
list.length(BestCasesList, BestLength),
|
|
Length < BestLength
|
|
->
|
|
BestAgain1 = BestAgain0
|
|
;
|
|
BestAgain1 = Again
|
|
),
|
|
select_best_switch(AgainList, BestAgain1, BestAgain).
|
|
|
|
:- pred detect_sub_switches_in_disj(module_info::in, vartypes::in, instmap::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out, bool::in, bool::out) is det.
|
|
|
|
detect_sub_switches_in_disj(_ModuleInfo, _VarTypes, _InstMap, [], [],
|
|
!Requant).
|
|
detect_sub_switches_in_disj(ModuleInfo, VarTypes, InstMap,
|
|
[Goal0 | Goals0], [Goal | Goals], !Requant) :-
|
|
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap, Goal0, Goal,
|
|
!Requant),
|
|
detect_sub_switches_in_disj(ModuleInfo, VarTypes, InstMap,
|
|
Goals0, Goals, !Requant).
|
|
|
|
:- pred detect_switches_in_cases(module_info::in, vartypes::in, instmap::in,
|
|
list(case)::in, list(case)::out, bool::in, bool::out) is det.
|
|
|
|
detect_switches_in_cases(_, _, _, [], [], !Requant).
|
|
detect_switches_in_cases(ModuleInfo, VarTypes, InstMap,
|
|
[Case0 | Cases0], [Case | Cases], !Requant) :-
|
|
Case0 = case(Functor, Goal0),
|
|
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap, Goal0, Goal,
|
|
!Requant),
|
|
Case = case(Functor, Goal),
|
|
detect_switches_in_cases(ModuleInfo, VarTypes, InstMap, Cases0, Cases,
|
|
!Requant).
|
|
|
|
:- pred detect_switches_in_conj(module_info::in, vartypes::in, instmap::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out, bool::in, bool::out) is det.
|
|
|
|
detect_switches_in_conj(_, _, _, [], [], !Requant).
|
|
detect_switches_in_conj(ModuleInfo, VarTypes, InstMap0,
|
|
[Goal0 | Goals0], [Goal | Goals], !Requant) :-
|
|
detect_switches_in_goal_1(ModuleInfo, VarTypes, InstMap0, InstMap1,
|
|
Goal0, Goal, !Requant),
|
|
detect_switches_in_conj(ModuleInfo, VarTypes, InstMap1, Goals0, Goals,
|
|
!Requant).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% partition_disj(Goals, Var, GoalInfo, VarTypes, ModuleInfo, Left, Cases):
|
|
%
|
|
% Attempts to partition the disjunction `Goals' into a switch on `Var'.
|
|
% If at least partially successful, returns the resulting `Cases', with
|
|
% any disjunction goals not fitting into the switch in Left.
|
|
%
|
|
% Given the list of goals in a disjunction, and an input variable to switch
|
|
% on, we attempt to partition the goals into a switch. For each constructor
|
|
% id, we record the list of disjuncts which unify the variable with that
|
|
% constructor. We partition the goals by abstractly interpreting the
|
|
% unifications at the start of each disjunction, to build up a
|
|
% substitution.
|
|
%
|
|
:- pred partition_disj(list(hlds_goal)::in, prog_var::in, hlds_goal_info::in,
|
|
list(hlds_goal)::out, sorted_case_list::out, bool::in, bool::out)
|
|
is semidet.
|
|
|
|
partition_disj(Goals0, Var, GoalInfo, Left, CasesList, !Requant) :-
|
|
map.init(Cases0),
|
|
partition_disj_trial(Goals0, Var, [], Left1, Cases0, Cases1),
|
|
map.to_assoc_list(Cases1, CasesAssocList1),
|
|
(
|
|
Left1 = [],
|
|
CasesAssocList1 = [_ | _], % There must be at least one case.
|
|
Left = Left1,
|
|
fix_case_list(CasesAssocList1, GoalInfo, CasesList)
|
|
;
|
|
Left1 = [_ | _],
|
|
% We don't insist on CasesAssocList1 not being empty, to allow for
|
|
% switches in which *all* cases contain subsidiary disjunctions.
|
|
( expand_sub_disjs(Var, Left1, Cases1, Cases) ->
|
|
Left = [],
|
|
map.to_assoc_list(Cases, CasesAssocList),
|
|
CasesAssocList = [_ | _], % There must be at least one case.
|
|
fix_case_list(CasesAssocList, GoalInfo, CasesList),
|
|
!:Requant = yes
|
|
;
|
|
Left = Left1,
|
|
fix_case_list(CasesAssocList1, GoalInfo, CasesList)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred expand_sub_disjs(prog_var::in, list(hlds_goal)::in,
|
|
cases::in, cases::out) is semidet.
|
|
|
|
expand_sub_disjs(_Var, [], !Cases).
|
|
expand_sub_disjs(Var, [LeftGoal | LeftGoals], !Cases) :-
|
|
expand_sub_disj(Var, LeftGoal, !Cases),
|
|
expand_sub_disjs(Var, LeftGoals, !Cases).
|
|
|
|
:- pred expand_sub_disj(prog_var::in, hlds_goal::in, cases::in, cases::out)
|
|
is semidet.
|
|
|
|
expand_sub_disj(Var, Goal, !Cases) :-
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0),
|
|
goal_info_add_feature(feature_duplicated_for_switch, GoalInfo0, GoalInfo),
|
|
( GoalExpr = conj(plain_conj, SubGoals) ->
|
|
expand_sub_disj_process_conj(Var, SubGoals, [], GoalInfo, !Cases)
|
|
; GoalExpr = disj(_) ->
|
|
expand_sub_disj_process_conj(Var, [Goal], [], GoalInfo, !Cases)
|
|
;
|
|
fail
|
|
).
|
|
|
|
:- pred expand_sub_disj_process_conj(prog_var::in, list(hlds_goal)::in,
|
|
list(hlds_goal)::in, hlds_goal_info::in, cases::in, cases::out) is semidet.
|
|
|
|
expand_sub_disj_process_conj(Var, ConjGoals, !.RevUnifies, GoalInfo,
|
|
!Cases) :-
|
|
(
|
|
ConjGoals = [],
|
|
fail
|
|
;
|
|
ConjGoals = [FirstGoal | RestGoals],
|
|
FirstGoal = hlds_goal(FirstGoalExpr, _),
|
|
( FirstGoalExpr = unify(_, _, _, _, _) ->
|
|
!:RevUnifies = [FirstGoal | !.RevUnifies],
|
|
expand_sub_disj_process_conj(Var, RestGoals, !.RevUnifies,
|
|
GoalInfo, !Cases)
|
|
; FirstGoalExpr = disj(Disjuncts) ->
|
|
Disjuncts = [_ | _],
|
|
list.reverse(!.RevUnifies, Unifies),
|
|
list.map(
|
|
create_expanded_conjunction(Unifies, RestGoals, GoalInfo),
|
|
Disjuncts, ExpandedConjunctions),
|
|
partition_disj_trial(ExpandedConjunctions, Var, [], Left, !Cases),
|
|
Left = []
|
|
;
|
|
fail
|
|
)
|
|
).
|
|
|
|
:- pred create_expanded_conjunction(list(hlds_goal)::in, list(hlds_goal)::in,
|
|
hlds_goal_info::in, hlds_goal::in, hlds_goal::out) is det.
|
|
|
|
create_expanded_conjunction(Unifies, RestGoals, GoalInfo, Disjunct, Goal) :-
|
|
( Disjunct = hlds_goal(conj(plain_conj, DisjunctGoals), _) ->
|
|
Conjuncts = Unifies ++ DisjunctGoals ++ RestGoals
|
|
;
|
|
Conjuncts = Unifies ++ [Disjunct] ++ RestGoals
|
|
),
|
|
Goal = hlds_goal(conj(plain_conj, Conjuncts), GoalInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred partition_disj_trial(list(hlds_goal)::in, prog_var::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out,
|
|
cases::in, cases::out) is det.
|
|
|
|
partition_disj_trial([], _Var, !Left, !Cases).
|
|
partition_disj_trial([Goal0 | Goals], Var, !Left, !Cases) :-
|
|
find_bind_var(Var, find_bind_var_for_switch_in_deconstruct, Goal0, Goal,
|
|
no, MaybeFunctor, unit, _, _),
|
|
(
|
|
MaybeFunctor = yes(Functor),
|
|
( map.search(!.Cases, Functor, DisjList0) ->
|
|
DisjList = [Goal | DisjList0],
|
|
map.det_update(!.Cases, Functor, DisjList, !:Cases)
|
|
;
|
|
DisjList = [Goal],
|
|
map.det_insert(!.Cases, Functor, DisjList, !:Cases)
|
|
)
|
|
;
|
|
MaybeFunctor = no,
|
|
!:Left = [Goal0 | !.Left]
|
|
),
|
|
partition_disj_trial(Goals, Var, !Left, !Cases).
|
|
|
|
:- pred find_bind_var_for_switch_in_deconstruct(prog_var::in, hlds_goal::in,
|
|
list(hlds_goal)::out, maybe(cons_id)::in, maybe(cons_id)::out,
|
|
unit::in, unit::out) is det.
|
|
|
|
find_bind_var_for_switch_in_deconstruct(SwitchVar, Goal0, Goals,
|
|
_Result0, Result, _, unit) :-
|
|
(
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
|
|
UnifyInfo0 = GoalExpr0 ^ unify_kind,
|
|
UnifyInfo0 = deconstruct(UnifyVar, Functor, ArgVars, _, _, _)
|
|
->
|
|
Result = yes(Functor),
|
|
(
|
|
ArgVars = [],
|
|
SwitchVar = UnifyVar
|
|
->
|
|
% The test will get carried out in the switch, there are no
|
|
% argument values to pick up, and the test was on the switch
|
|
% variable (not on one of its aliases), so the unification
|
|
% serve no further purpose. We delete it here, so simplify
|
|
% doesn't have to.
|
|
Goals = []
|
|
;
|
|
% The deconstruction unification now becomes deterministic, since
|
|
% the test will get carried out in the switch.
|
|
UnifyInfo = UnifyInfo0 ^ deconstruct_can_fail := cannot_fail,
|
|
GoalExpr = GoalExpr0 ^ unify_kind := UnifyInfo,
|
|
Goal = hlds_goal(GoalExpr, GoalInfo),
|
|
Goals = [Goal]
|
|
)
|
|
;
|
|
unexpected(this_file, "find_bind_var_for_switch_in_deconstruct")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
find_bind_var(Var, ProcessUnify, !Goal, !Result, !Info, FoundDeconstruct) :-
|
|
map.init(Subst),
|
|
find_bind_var_2(Var, ProcessUnify, !Goal, Subst, _, !Result, !Info,
|
|
DeconstructSearch),
|
|
(
|
|
DeconstructSearch = before_deconstruct,
|
|
FoundDeconstruct = no
|
|
;
|
|
DeconstructSearch = found_deconstruct,
|
|
FoundDeconstruct = yes
|
|
;
|
|
DeconstructSearch = given_up_search,
|
|
FoundDeconstruct = no
|
|
).
|
|
|
|
:- type deconstruct_search
|
|
---> before_deconstruct
|
|
; found_deconstruct
|
|
; given_up_search.
|
|
|
|
:- pred find_bind_var_2(prog_var::in,
|
|
process_unify(Result, Info)::in(process_unify),
|
|
hlds_goal::in, hlds_goal::out,
|
|
prog_substitution::in, prog_substitution::out, Result::in, Result::out,
|
|
Info::in, Info::out, deconstruct_search::out) is det.
|
|
|
|
find_bind_var_2(Var, ProcessUnify, Goal0, Goal, !Subst, !Result, !Info,
|
|
FoundDeconstruct) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
|
|
(
|
|
GoalExpr0 = scope(Reason, SubGoal0)
|
|
->
|
|
find_bind_var_2(Var, ProcessUnify, SubGoal0, SubGoal, !Subst,
|
|
!Result, !Info, FoundDeconstruct),
|
|
Goal = hlds_goal(scope(Reason, SubGoal), GoalInfo)
|
|
;
|
|
GoalExpr0 = conj(ConjType, SubGoals0),
|
|
ConjType = plain_conj
|
|
->
|
|
(
|
|
SubGoals0 = [],
|
|
Goal = Goal0,
|
|
FoundDeconstruct = before_deconstruct
|
|
;
|
|
SubGoals0 = [_ | _],
|
|
conj_find_bind_var(Var, ProcessUnify, SubGoals0, SubGoals,
|
|
!Subst, !Result, !Info, FoundDeconstruct),
|
|
Goal = hlds_goal(conj(ConjType, SubGoals), GoalInfo)
|
|
)
|
|
;
|
|
GoalExpr0 = unify(LHS, RHS, _, UnifyInfo0, _)
|
|
->
|
|
(
|
|
% Check whether the unification is a deconstruction unification
|
|
% on either Var or on a variable aliased to Var.
|
|
UnifyInfo0 = deconstruct(UnifyVar, _, _, _, _, _),
|
|
term.apply_rec_substitution(term.variable(Var, context_init),
|
|
!.Subst, term.variable(SubstVar, context_init)),
|
|
term.apply_rec_substitution(term.variable(UnifyVar, context_init),
|
|
!.Subst, term.variable(SubstUnifyVar, context_init)),
|
|
SubstVar = SubstUnifyVar
|
|
->
|
|
call(ProcessUnify, Var, Goal0, Goals, !Result, !Info),
|
|
conj_list_to_goal(Goals, GoalInfo, Goal),
|
|
FoundDeconstruct = found_deconstruct
|
|
;
|
|
Goal = Goal0,
|
|
FoundDeconstruct = before_deconstruct,
|
|
% Otherwise abstractly interpret the unification.
|
|
( interpret_unify(LHS, RHS, !.Subst, NewSubst) ->
|
|
!:Subst = NewSubst
|
|
;
|
|
% The unification must fail - just ignore it.
|
|
true
|
|
)
|
|
)
|
|
;
|
|
Goal = Goal0,
|
|
( goal_info_has_feature(GoalInfo, feature_from_head) ->
|
|
FoundDeconstruct = before_deconstruct
|
|
;
|
|
FoundDeconstruct = given_up_search
|
|
)
|
|
).
|
|
|
|
:- pred conj_find_bind_var(prog_var::in,
|
|
process_unify(Result, Info)::in(process_unify),
|
|
list(hlds_goal)::in, list(hlds_goal)::out,
|
|
prog_substitution::in, prog_substitution::out, Result::in, Result::out,
|
|
Info::in, Info::out, deconstruct_search::out) is det.
|
|
|
|
conj_find_bind_var(_Var, _, [], [], !Subst, !Result, !Info,
|
|
before_deconstruct).
|
|
conj_find_bind_var(Var, ProcessUnify, [Goal0 | Goals0], [Goal | Goals],
|
|
!Subst, !Result, !Info, FoundDeconstruct) :-
|
|
find_bind_var_2(Var, ProcessUnify, Goal0, Goal, !Subst,
|
|
!Result, !Info, FoundDeconstruct1),
|
|
( FoundDeconstruct1 = before_deconstruct ->
|
|
conj_find_bind_var(Var, ProcessUnify, Goals0, Goals,
|
|
!Subst, !Result, !Info, FoundDeconstruct)
|
|
;
|
|
FoundDeconstruct = FoundDeconstruct1,
|
|
Goals = Goals0
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred cases_to_switch(sorted_case_list::in, prog_var::in, vartypes::in,
|
|
hlds_goal_info::in, instmap::in, module_info::in, hlds_goal_expr::out,
|
|
bool::in, bool::out) is det.
|
|
|
|
cases_to_switch(CasesList, Var, VarTypes, _GoalInfo, InstMap, ModuleInfo,
|
|
Goal, !Requant) :-
|
|
instmap.lookup_var(InstMap, Var, VarInst),
|
|
( inst_is_bound_to_functors(ModuleInfo, VarInst, Functors) ->
|
|
functors_to_cons_ids(Functors, ConsIds0),
|
|
list.sort(ConsIds0, ConsIds),
|
|
delete_unreachable_cases(CasesList, ConsIds, CasesList1),
|
|
( list.same_length(Functors, CasesList1) ->
|
|
CanFail = cannot_fail
|
|
;
|
|
CanFail = can_fail
|
|
)
|
|
;
|
|
map.lookup(VarTypes, Var, Type),
|
|
CasesList1 = CasesList,
|
|
( switch_covers_all_cases(ModuleInfo, Type, CasesList1) ->
|
|
CanFail = cannot_fail
|
|
;
|
|
CanFail = can_fail
|
|
)
|
|
),
|
|
detect_switches_in_cases(ModuleInfo, VarTypes, InstMap,
|
|
CasesList1, Cases, !Requant),
|
|
|
|
% We turn switches with no arms into fail, since this avoids having
|
|
% the code generator flush the control variable of the switch.
|
|
% We can't easily eliminate switches with one arm, since the
|
|
% code of the arm will have the unification between the variable
|
|
% and the function symbol as det. The gain would be minimal to
|
|
% nonexistent anyway.
|
|
(
|
|
Cases = [],
|
|
Goal = disj([])
|
|
;
|
|
Cases = [_ | _],
|
|
Goal = switch(Var, CanFail, Cases)
|
|
).
|
|
|
|
% Check whether a switch handles all the possible constants/functors
|
|
% for the type.
|
|
%
|
|
:- pred switch_covers_all_cases(module_info::in, mer_type::in,
|
|
sorted_case_list::in) is semidet.
|
|
|
|
switch_covers_all_cases(ModuleInfo, Type, CasesList) :-
|
|
type_util.switch_type_num_functors(ModuleInfo, Type, NumFunctors),
|
|
list.length(CasesList, NumCases),
|
|
NumCases = NumFunctors.
|
|
|
|
% Convert the assoc_list(cons_id, list(hlds_goal)) back into a plain
|
|
% list(case).
|
|
%
|
|
:- pred fix_case_list(assoc_list(cons_id, list(hlds_goal))::in,
|
|
hlds_goal_info::in, list(case)::out) is det.
|
|
|
|
fix_case_list([], _, []).
|
|
fix_case_list([Functor - DisjList0 | Cases0], GoalInfo,
|
|
[case(Functor, Goal) | Cases]) :-
|
|
% We need to put the list back the right way around.
|
|
list.reverse(DisjList0, DisjList),
|
|
disj_list_to_goal(DisjList, GoalInfo, Goal),
|
|
fix_case_list(Cases0, GoalInfo, Cases).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "switch_detection.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|