mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-17 06:47:17 +00:00
Code Issues Projects Releases Wiki Activity
Files
b56885be93105b322ac55701ae6af30b2468d53f
mercury/compiler/cse_detection.m
Zoltan Somogyi b56885be93 Fix a bug that caused bootchecks with --optimize-constructor-last-call to fail. 
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.
2007-01-19 07:05:06 +00:00

860 lines
34 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-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: cse_detection.m.
% Main author: zs.
% Much of the code is based on switch_detection.m by fjh.
%
% Common subexpression detection - hoist common subexpression goals out of
% branched structures. This can enable us to find more indexing opportunities
% and hence can make the code more deterministic.
% This code is switched on/off with the `--common-goal' option.
%
%-----------------------------------------------------------------------------%
:- module check_hlds.cse_detection.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module io.
:- pred detect_cse(module_info::in, module_info::out, io::di, io::uo) is det.
:- pred detect_cse_in_proc(proc_id::in, pred_id::in,
module_info::in, module_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.modes.
:- import_module check_hlds.switch_detection.
:- import_module check_hlds.switch_detection.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module hlds.quantification.
:- import_module libs.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type_subst.
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module pair.
:- import_module set.
:- import_module string.
:- import_module svmap.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
detect_cse(!ModuleInfo, !IO) :-
% Traverse the module structure, calling `detect_cse_in_goal'
% for each procedure body.
module_info_predids(PredIds, !ModuleInfo),
detect_cse_in_preds(PredIds, !ModuleInfo, !IO).
:- pred detect_cse_in_preds(list(pred_id)::in,
module_info::in, module_info::out, io::di, io::uo) is det.
detect_cse_in_preds([], !ModuleInfo, !IO).
detect_cse_in_preds([PredId | PredIds], !ModuleInfo, !IO) :-
module_info_preds(!.ModuleInfo, PredTable),
map.lookup(PredTable, PredId, PredInfo),
detect_cse_in_pred(PredId, PredInfo, !ModuleInfo, !IO),
detect_cse_in_preds(PredIds, !ModuleInfo, !IO).
:- pred detect_cse_in_pred(pred_id::in, pred_info::in,
module_info::in, module_info::out, io::di, io::uo) is det.
detect_cse_in_pred(PredId, PredInfo0, !ModuleInfo, !IO) :-
ProcIds = pred_info_non_imported_procids(PredInfo0),
detect_cse_in_procs(ProcIds, PredId, !ModuleInfo, !IO).
:- pred detect_cse_in_procs(list(proc_id)::in, pred_id::in,
module_info::in, module_info::out, io::di, io::uo) is det.
detect_cse_in_procs([], _PredId, !ModuleInfo, !IO).
detect_cse_in_procs([ProcId | ProcIds], PredId, !ModuleInfo, !IO) :-
detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO),
detect_cse_in_procs(ProcIds, PredId, !ModuleInfo, !IO).
detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO) :-
detect_cse_in_proc_2(ProcId, PredId, Redo, !ModuleInfo),
globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
(
VeryVerbose = yes,
io.write_string("% Detecting common deconstructions for ", !IO),
hlds_out.write_pred_id(!.ModuleInfo, PredId, !IO),
io.write_string("\n", !IO)
;
VeryVerbose = no
),
globals.io_lookup_bool_option(detailed_statistics, Statistics, !IO),
maybe_report_stats(Statistics, !IO),
(
Redo = no
;
Redo = yes,
(
VeryVerbose = yes,
io.write_string("% Repeating mode check for ", !IO),
hlds_out.write_pred_id(!.ModuleInfo, PredId, !IO),
io.write_string("\n", !IO)
;
VeryVerbose = no
),
modecheck_proc(ProcId, PredId, !ModuleInfo, Errs, _Changed, !IO),
maybe_report_stats(Statistics, !IO),
( Errs > 0 ->
unexpected(this_file, "mode check fails when repeated")
;
true
),
(
VeryVerbose = yes,
io.write_string("% Repeating switch detection for ", !IO),
hlds_out.write_pred_id(!.ModuleInfo, PredId, !IO),
io.write_string("\n", !IO)
;
VeryVerbose = no
),
detect_switches_in_proc(ProcId, PredId, !ModuleInfo),
maybe_report_stats(Statistics, !IO),
(
VeryVerbose = yes,
io.write_string("% Repeating common " ++
"deconstruction detection for ", !IO),
hlds_out.write_pred_id(!.ModuleInfo, PredId, !IO),
io.write_string("\n", !IO)
;
VeryVerbose = no
),
detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO)
).
:- type cse_info
---> cse_info(
varset :: prog_varset,
vartypes :: vartypes,
rtti_varmaps :: rtti_varmaps,
module_info :: module_info
).
:- pred detect_cse_in_proc_2(proc_id::in, pred_id::in, bool::out,
module_info::in, module_info::out) is det.
detect_cse_in_proc_2(ProcId, PredId, Redo, ModuleInfo0, ModuleInfo) :-
module_info_preds(ModuleInfo0, 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_cse_in_goal'.
proc_info_get_goal(ProcInfo0, Goal0),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
proc_info_get_varset(ProcInfo0, Varset0),
proc_info_get_vartypes(ProcInfo0, VarTypes0),
proc_info_get_rtti_varmaps(ProcInfo0, RttiVarMaps0),
CseInfo0 = cse_info(Varset0, VarTypes0, RttiVarMaps0, ModuleInfo0),
detect_cse_in_goal(Goal0, InstMap0, CseInfo0, CseInfo, Redo, Goal1),
(
Redo = no,
ModuleInfo = ModuleInfo0
;
Redo = yes,
% ModuleInfo should not be changed by detect_cse_in_goal.
CseInfo = cse_info(VarSet1, VarTypes1, RttiVarMaps1, _),
proc_info_get_headvars(ProcInfo0, HeadVars),
implicitly_quantify_clause_body(HeadVars, _Warnings,
Goal1, Goal, VarSet1, VarSet, VarTypes1, VarTypes,
RttiVarMaps1, RttiVarMaps),
proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
proc_info_set_varset(VarSet, ProcInfo1, ProcInfo2),
proc_info_set_vartypes(VarTypes, ProcInfo2, ProcInfo3),
proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo3, ProcInfo),
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, ModuleInfo0, ModuleInfo)
).
%-----------------------------------------------------------------------------%
% Given a goal, and the instmap on entry to that goal,
% find disjunctions that contain common subexpressions
% and hoist these out of the disjunction. At the moment
% we only look for cses that are deconstruction unifications.
%
:- pred detect_cse_in_goal(hlds_goal::in, instmap::in, cse_info::in,
cse_info::out, bool::out, hlds_goal::out) is det.
detect_cse_in_goal(Goal0, InstMap0, !CseInfo, Redo, Goal) :-
detect_cse_in_goal_1(Goal0, InstMap0, !CseInfo, Redo, Goal, _InstMap).
% 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_cse_in_goal_1(hlds_goal::in, instmap::in, cse_info::in,
cse_info::out, bool::out, hlds_goal::out, instmap::out) is det.
detect_cse_in_goal_1(hlds_goal(GoalExpr0, GoalInfo), InstMap0, !CseInfo, Redo,
hlds_goal(GoalExpr, GoalInfo), InstMap) :-
detect_cse_in_goal_2(GoalExpr0, GoalInfo, InstMap0, !CseInfo, Redo,
GoalExpr),
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
instmap.apply_instmap_delta(InstMap0, InstMapDelta, InstMap).
% Here we process each of the different sorts of goals.
%
:- pred detect_cse_in_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
instmap::in, cse_info::in, cse_info::out, bool::out,
hlds_goal_expr::out) is det.
detect_cse_in_goal_2(Goal @ call_foreign_proc(_, _, _, _, _, _, _), _, _,
!CseInfo, no, Goal).
detect_cse_in_goal_2(Goal @ generic_call(_, _, _, _), _, _, !CseInfo,
no, Goal).
detect_cse_in_goal_2(Goal @ plain_call(_, _, _, _, _, _), _, _, !CseInfo,
no, Goal).
detect_cse_in_goal_2(unify(LHS, RHS0, Mode, Unify, UnifyContext), _, InstMap0,
!CseInfo, Redo, unify(LHS, RHS, Mode,Unify, UnifyContext)) :-
(
RHS0 = rhs_lambda_goal(Purity, PredOrFunc, EvalMethod, NonLocalVars,
Vars, Modes, Det, Goal0),
ModuleInfo = !.CseInfo ^ module_info,
instmap.pre_lambda_update(ModuleInfo, Vars, Modes, InstMap0, InstMap),
detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo, Goal),
RHS = rhs_lambda_goal(Purity, PredOrFunc, EvalMethod, NonLocalVars,
Vars, Modes, Det, Goal)
;
( RHS0 = rhs_var(_)
; RHS0 = rhs_functor(_, _, _)
),
RHS = RHS0,
Redo = no
).
detect_cse_in_goal_2(negation(Goal0), _GoalInfo, InstMap, !CseInfo, Redo,
negation(Goal)) :-
detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo, Goal).
detect_cse_in_goal_2(scope(Reason, Goal0), _GoalInfo, InstMap,
!CseInfo, Redo, scope(Reason, Goal)) :-
detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo, Goal).
detect_cse_in_goal_2(conj(ConjType, Goals0), _GoalInfo, InstMap, !CseInfo,
Redo, conj(ConjType, Goals)) :-
detect_cse_in_conj(Goals0, ConjType, InstMap, !CseInfo, Redo, Goals).
detect_cse_in_goal_2(disj(Goals0), GoalInfo, InstMap, !CseInfo, Redo, Goal) :-
( Goals0 = [] ->
Redo = no,
Goal = disj([])
;
goal_info_get_nonlocals(GoalInfo, NonLocals),
set.to_sorted_list(NonLocals, NonLocalsList),
detect_cse_in_disj(NonLocalsList, Goals0, GoalInfo,
InstMap, !CseInfo, Redo, Goal)
).
detect_cse_in_goal_2(switch(Var, CanFail, Cases0), GoalInfo, InstMap,
!CseInfo, Redo, Goal) :-
goal_info_get_nonlocals(GoalInfo, NonLocals),
set.to_sorted_list(NonLocals, NonLocalsList),
detect_cse_in_cases(NonLocalsList, Var, CanFail, Cases0, GoalInfo,
InstMap, !CseInfo, Redo, Goal).
detect_cse_in_goal_2(if_then_else(Vars, Cond0, Then0, Else0), GoalInfo,
InstMap, !CseInfo, Redo, Goal) :-
goal_info_get_nonlocals(GoalInfo, NonLocals),
set.to_sorted_list(NonLocals, NonLocalsList),
detect_cse_in_ite(NonLocalsList, Vars, Cond0, Then0, Else0, GoalInfo,
InstMap, !CseInfo, Redo, Goal).
detect_cse_in_goal_2(shorthand(_), _, _, _, _, _, _) :-
% These should have been expanded out by now.
unexpected(this_file, "detect_cse_in_goal_2: unexpected shorthand").
%-----------------------------------------------------------------------------%
:- pred detect_cse_in_conj(list(hlds_goal)::in, conj_type::in, instmap::in,
cse_info::in, cse_info::out, bool::out, list(hlds_goal)::out) is det.
detect_cse_in_conj([], _ConjType, _InstMap, !CseInfo, no, []).
detect_cse_in_conj([Goal0 | Goals0], ConjType, InstMap0, !CseInfo, Redo,
Goals) :-
detect_cse_in_goal_1(Goal0, InstMap0, !CseInfo, Redo1, Goal, InstMap1),
detect_cse_in_conj(Goals0, ConjType, InstMap1, !CseInfo, Redo2, TailGoals),
(
Goal = hlds_goal(conj(InnerConjType, ConjGoals), _),
ConjType = InnerConjType
->
Goals = ConjGoals ++ TailGoals
;
Goals = [Goal | TailGoals]
),
bool.or(Redo1, Redo2, Redo).
%-----------------------------------------------------------------------------%
% These are the interesting bits - we've found a non-empty branched
% structure, and we've got a list of the non-local variables of that
% structure. Now for each non-local variable, we check whether each
% branch matches that variable against the same functor.
%
:- pred detect_cse_in_disj(list(prog_var)::in, list(hlds_goal)::in,
hlds_goal_info::in, instmap::in, cse_info::in,
cse_info::out, bool::out, hlds_goal_expr::out) is det.
detect_cse_in_disj([], Goals0, _, InstMap, !CseInfo, Redo, disj(Goals)) :-
detect_cse_in_disj_2(Goals0, InstMap, !CseInfo, Redo, Goals).
detect_cse_in_disj([Var | Vars], Goals0, GoalInfo0, InstMap,
!CseInfo, Redo, GoalExpr) :-
(
instmap.lookup_var(InstMap, Var, VarInst0),
ModuleInfo = !.CseInfo ^ module_info,
% XXX we only need inst_is_bound, but leave this as it is
% until mode analysis can handle aliasing between free
% variables.
inst_is_ground_or_any(ModuleInfo, VarInst0),
common_deconstruct(Goals0, Var, !CseInfo, Unify,
FirstOldNew, LaterOldNew, Goals)
->
maybe_update_existential_data_structures(Unify,
FirstOldNew, LaterOldNew, !CseInfo),
GoalExpr = conj(plain_conj,
[Unify, hlds_goal(disj(Goals), GoalInfo0)]),
Redo = yes
;
detect_cse_in_disj(Vars, Goals0, GoalInfo0, InstMap,
!CseInfo, Redo, GoalExpr)
).
:- pred detect_cse_in_disj_2(list(hlds_goal)::in, instmap::in, cse_info::in,
cse_info::out, bool::out, list(hlds_goal)::out) is det.
detect_cse_in_disj_2([], _InstMap, !CseInfo, no, []).
detect_cse_in_disj_2([Goal0 | Goals0], InstMap0, !CseInfo, Redo,
[Goal | Goals]) :-
detect_cse_in_goal(Goal0, InstMap0, !CseInfo, Redo1, Goal),
detect_cse_in_disj_2(Goals0, InstMap0, !CseInfo, Redo2, Goals),
bool.or(Redo1, Redo2, Redo).
:- pred detect_cse_in_cases(list(prog_var)::in, prog_var::in, can_fail::in,
list(case)::in, hlds_goal_info::in, instmap::in,
cse_info::in, cse_info::out, bool::out, hlds_goal_expr::out) is det.
detect_cse_in_cases([], SwitchVar, CanFail, Cases0, _GoalInfo, InstMap,
!CseInfo, Redo, switch(SwitchVar, CanFail, Cases)) :-
detect_cse_in_cases_2(Cases0, InstMap, !CseInfo, Redo, Cases).
detect_cse_in_cases([Var | Vars], SwitchVar, CanFail, Cases0, GoalInfo,
InstMap, !CseInfo, Redo, GoalExpr) :-
(
Var \= SwitchVar,
instmap.lookup_var(InstMap, Var, VarInst0),
ModuleInfo = !.CseInfo ^ module_info,
% XXX We only need inst_is_bound, but leave this as it is until
% mode analysis can handle aliasing between free variables.
inst_is_ground_or_any(ModuleInfo, VarInst0),
common_deconstruct_cases(Cases0, Var, !CseInfo,
Unify, FirstOldNew, LaterOldNew, Cases)
->
maybe_update_existential_data_structures(Unify,
FirstOldNew, LaterOldNew, !CseInfo),
GoalExpr = conj(plain_conj,
[Unify, hlds_goal(switch(SwitchVar, CanFail, Cases), GoalInfo)]),
Redo = yes
;
detect_cse_in_cases(Vars, SwitchVar, CanFail, Cases0, GoalInfo,
InstMap, !CseInfo, Redo, GoalExpr)
).
:- pred detect_cse_in_cases_2(list(case)::in, instmap::in, cse_info::in,
cse_info::out, bool::out, list(case)::out) is det.
detect_cse_in_cases_2([], _, !CseInfo, no, []).
detect_cse_in_cases_2([Case0 | Cases0], InstMap, !CseInfo, Redo,
[Case | Cases]) :-
Case0 = case(Functor, Goal0),
detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo1, Goal),
Case = case(Functor, Goal),
detect_cse_in_cases_2(Cases0, InstMap, !CseInfo, Redo2, Cases),
bool.or(Redo1, Redo2, Redo).
:- pred detect_cse_in_ite(list(prog_var)::in, list(prog_var)::in,
hlds_goal::in, hlds_goal::in, hlds_goal::in, hlds_goal_info::in,
instmap::in, cse_info::in, cse_info::out, bool::out,
hlds_goal_expr::out) is det.
detect_cse_in_ite([], IfVars, Cond0, Then0, Else0, _, InstMap, !CseInfo,
Redo, if_then_else(IfVars, Cond, Then, Else)) :-
detect_cse_in_ite_2(Cond0, Then0, Else0, InstMap, !CseInfo, Redo,
Cond, Then, Else).
detect_cse_in_ite([Var | Vars], IfVars, Cond0, Then0, Else0, GoalInfo,
InstMap, !CseInfo, Redo, GoalExpr) :-
(
ModuleInfo = !.CseInfo ^ module_info,
instmap.lookup_var(InstMap, Var, VarInst0),
% XXX We only need inst_is_bound, but leave this as it is until
% mode analysis can handle aliasing between free variables.
inst_is_ground_or_any(ModuleInfo, VarInst0),
common_deconstruct([Then0, Else0], Var, !CseInfo,
Unify, FirstOldNew, LaterOldNew, Goals),
Goals = [Then, Else]
->
maybe_update_existential_data_structures(Unify,
FirstOldNew, LaterOldNew, !CseInfo),
IfGoal = hlds_goal(if_then_else(IfVars, Cond0, Then, Else), GoalInfo),
GoalExpr = conj(plain_conj, [Unify, IfGoal]),
Redo = yes
;
detect_cse_in_ite(Vars, IfVars, Cond0, Then0, Else0, GoalInfo,
InstMap, !CseInfo, Redo, GoalExpr)
).
:- pred detect_cse_in_ite_2(hlds_goal::in, hlds_goal::in, hlds_goal::in,
instmap::in, cse_info::in, cse_info::out, bool::out,
hlds_goal::out, hlds_goal::out, hlds_goal::out) is det.
detect_cse_in_ite_2(Cond0, Then0, Else0, InstMap0, !CseInfo, Redo,
Cond, Then, Else) :-
detect_cse_in_goal_1(Cond0, InstMap0, !CseInfo, Redo1, Cond, InstMap1),
detect_cse_in_goal(Then0, InstMap1, !CseInfo, Redo2, Then),
detect_cse_in_goal(Else0, InstMap0, !CseInfo, Redo3, Else),
bool.or(Redo1, Redo2, Redo12),
bool.or(Redo12, Redo3, Redo).
%-----------------------------------------------------------------------------%
% common_deconstruct(Goals0, Var, !CseInfo, Unify, Goals):
% input vars:
% Goals0 is a list of parallel goals in a branched structure
% (disjunction, if-then-else, or switch).
% Var is the variable we are looking for a common deconstruction on.
% !.CseInfo contains the original varset and type map.
% output vars:
% !:CseInfo has a varset and a type map reflecting the new variables
% we have introduced.
% Goals is the modified version of Goals0 after the common deconstruction
% has been hoisted out, with the new variables as the functor arguments.
% Unify is the unification that was hoisted out.
%
:- pred common_deconstruct(list(hlds_goal)::in, prog_var::in, cse_info::in,
cse_info::out, hlds_goal::out, assoc_list(prog_var)::out,
list(assoc_list(prog_var))::out, list(hlds_goal)::out) is semidet.
common_deconstruct(Goals0, Var, !CseInfo, Unify, FirstOldNew, LaterOldNew,
Goals) :-
common_deconstruct_2(Goals0, Var, before_candidate,
have_candidate(Unify, FirstOldNew, LaterOldNew), !CseInfo, Goals),
LaterOldNew = [_ | _].
:- pred common_deconstruct_2(list(hlds_goal)::in, prog_var::in,
cse_state::in, cse_state::out, cse_info::in, cse_info::out,
list(hlds_goal)::out) is semidet.
common_deconstruct_2([], _Var, !CseState, !CseInfo, []).
common_deconstruct_2([Goal0 | Goals0], Var, !CseState, !CseInfo,
[Goal | Goals]) :-
find_bind_var(Var, find_bind_var_for_cse_in_deconstruct, Goal0, Goal,
!CseState, !CseInfo, yes),
!.CseState = have_candidate(_, _, _),
common_deconstruct_2(Goals0, Var, !CseState, !CseInfo, Goals).
%-----------------------------------------------------------------------------%
:- pred common_deconstruct_cases(list(case)::in, prog_var::in,
cse_info::in, cse_info::out, hlds_goal::out, assoc_list(prog_var)::out,
list(assoc_list(prog_var))::out, list(case)::out) is semidet.
common_deconstruct_cases(Cases0, Var, !CseInfo, Unify,
FirstOldNew, LaterOldNew, Cases) :-
common_deconstruct_cases_2(Cases0, Var, before_candidate,
have_candidate(Unify, FirstOldNew, LaterOldNew), !CseInfo, Cases),
LaterOldNew = [_ | _].
:- pred common_deconstruct_cases_2(list(case)::in, prog_var::in,
cse_state::in, cse_state::out, cse_info::in, cse_info::out,
list(case)::out) is semidet.
common_deconstruct_cases_2([], _Var, !CseState, !CseInfo, []).
common_deconstruct_cases_2([case(ConsId, Goal0) | Cases0], Var,
!CseState, !CseInfo, [case(ConsId, Goal) | Cases]) :-
find_bind_var(Var, find_bind_var_for_cse_in_deconstruct, Goal0, Goal,
!CseState, !CseInfo, yes),
!.CseState = have_candidate(_, _, _),
common_deconstruct_cases_2(Cases0, Var, !CseState, !CseInfo, Cases).
%-----------------------------------------------------------------------------%
% This data structure represents the state of the search for
% deconstructions in all the branches of a branched control structure
% that deconstruct a given variable with the same functor.
% Initially, we don't know what unification we will hoist out, so the
% state is before_candidate. When we find a unification we want to
% hoist out, this fixes the functor, and the state is have_candidate.
% If we find that some branches unify that variable with some other
% functor, we have multiple_candidates, which means that we don't hoist
% out any of them. (Although our caller may try again with another
% variable.)
%
% The goal field contains the unification we are proposing to put
% before the branched control structure. The first_old_new field
% gives the mapping from argument variables in the old unification
% in the first branch to the freshly created variables in the goal
% being hoisted before the branched control structure. The
% later_old_new field contains the same information for the second
% and later branches.
:- type cse_state
---> before_candidate
; have_candidate(
goal :: hlds_goal,
first_old_new :: assoc_list(prog_var),
later_old_new :: list(assoc_list(prog_var))
)
; multiple_candidates.
:- pred find_bind_var_for_cse_in_deconstruct(prog_var::in, hlds_goal::in,
list(hlds_goal)::out, cse_state::in, cse_state::out,
cse_info::in, cse_info::out) is det.
find_bind_var_for_cse_in_deconstruct(Var, Goal0, Goals,
!CseState, !CseInfo) :-
(
!.CseState = before_candidate,
construct_common_unify(Var, Goal0, !CseInfo, OldNewVars,
HoistedGoal, Goals),
!:CseState = have_candidate(HoistedGoal, OldNewVars, [])
;
!.CseState = have_candidate(HoistedGoal,
FirstOldNewVars, LaterOldNewVars0),
Goal0 = hlds_goal(_, GoalInfo),
goal_info_get_context(GoalInfo, Context),
(
find_similar_deconstruct(HoistedGoal,
Goal0, Context, OldNewVars, Goals0)
->
Goals = Goals0,
LaterOldNewVars = [OldNewVars | LaterOldNewVars0],
!:CseState = have_candidate(HoistedGoal,
FirstOldNewVars, LaterOldNewVars)
;
Goals = [Goal0],
!:CseState = multiple_candidates
)
;
!.CseState = multiple_candidates,
Goals = [Goal0],
!:CseState = multiple_candidates
).
:- pred construct_common_unify(prog_var::in, hlds_goal::in,
cse_info::in, cse_info::out, assoc_list(prog_var)::out,
hlds_goal::out, list(hlds_goal)::out) is det.
construct_common_unify(Var, hlds_goal(GoalExpr0, GoalInfo), !CseInfo,
OldNewVars, HoistedGoal, Replacements) :-
(
GoalExpr0 = unify(_, RHS, Umode, Unif0, Ucontext),
Unif0 = deconstruct(_, Consid, Args, Submodes, CanFail, CanCGC)
->
Unif = deconstruct(Var, Consid, Args, Submodes, CanFail, CanCGC),
( RHS = rhs_functor(_, _, _) ->
GoalExpr1 = unify(Var, RHS, Umode, Unif, Ucontext)
;
unexpected(this_file,
"non-functor unify in construct_common_unify")
),
goal_info_get_context(GoalInfo, Context),
create_parallel_subterms(Args, Context, Ucontext, !CseInfo,
OldNewVars, Replacements),
map.from_assoc_list(OldNewVars, Sub),
rename_some_vars_in_goal(Sub, hlds_goal(GoalExpr1, GoalInfo),
HoistedGoal)
;
unexpected(this_file, "non-unify goal in construct_common_unify")
).
:- pred create_parallel_subterms(list(prog_var)::in, prog_context::in,
unify_context::in, cse_info::in, cse_info::out,
assoc_list(prog_var)::out, list(hlds_goal)::out) is det.
create_parallel_subterms([], _, _, !CseInfo, [], []).
create_parallel_subterms([OFV | OFV0], Context, UnifyContext, !CseInfo,
OldNewVars, Replacements) :-
create_parallel_subterms(OFV0, Context, UnifyContext, !CseInfo,
OldNewVars1, Replacements1),
create_parallel_subterm(OFV, Context, UnifyContext, !CseInfo,
OldNewVars1, OldNewVars, Goal),
Replacements = [Goal | Replacements1].
:- pred create_parallel_subterm(prog_var::in, prog_context::in,
unify_context::in, cse_info::in, cse_info::out,
assoc_list(prog_var)::in, assoc_list(prog_var)::out,
hlds_goal::out) is det.
create_parallel_subterm(OFV, Context, UnifyContext, !CseInfo, !OldNewVar,
Goal) :-
VarSet0 = !.CseInfo ^ varset,
VarTypes0 = !.CseInfo ^ vartypes,
varset.new_var(VarSet0, NFV, VarSet),
map.lookup(VarTypes0, OFV, Type),
map.det_insert(VarTypes0, NFV, Type, VarTypes),
!:OldNewVar = [OFV - NFV | !.OldNewVar],
UnifyContext = unify_context(MainCtxt, SubCtxt),
% It is ok to create complicated unifications here, because we rerun
% mode analysis on the resulting goal. It would be nicer to generate
% the right assignment unification directly, but that would require keeping
% track of the inst of OFV.
create_pure_atomic_complicated_unification(OFV, rhs_var(NFV),
Context, MainCtxt, SubCtxt, Goal),
!:CseInfo = !.CseInfo ^ varset := VarSet,
!:CseInfo = !.CseInfo ^ vartypes := VarTypes.
%-----------------------------------------------------------------------------%
:- pred find_similar_deconstruct(hlds_goal::in, hlds_goal::in,
prog_context::in, assoc_list(prog_var)::out, list(hlds_goal)::out)
is semidet.
find_similar_deconstruct(HoistedUnifyGoal, OldUnifyGoal, Context,
OldHoistedVars, Replacements) :-
(
HoistedUnifyGoal = hlds_goal(unify(_, _, _, HoistedUnifyInfo, OC), _),
HoistedUnifyInfo = deconstruct(_, HoistedFunctor,
HoistedVars, _, _, _),
OldUnifyGoal = hlds_goal(unify(_, _, _, OldUnifyInfo, _NC), _),
OldUnifyInfo = deconstruct(_, OldFunctor, OldVars, _, _, _)
->
HoistedFunctor = OldFunctor,
list.length(HoistedVars, HoistedVarsCount),
list.length(OldVars, OldVarsCount),
HoistedVarsCount = OldVarsCount,
assoc_list.from_corresponding_lists(OldVars, HoistedVars,
OldHoistedVars),
pair_subterms(OldHoistedVars, Context, OC, Replacements)
;
unexpected(this_file,
"find_similar_deconstruct: non-deconstruct unify")
).
:- pred pair_subterms(assoc_list(prog_var)::in, prog_context::in,
unify_context::in, list(hlds_goal)::out) is det.
pair_subterms([], _Context, _UnifyContext, []).
pair_subterms([OldVar - HoistedVar | OldHoistedVars], Context, UnifyContext,
Replacements) :-
pair_subterms(OldHoistedVars, Context, UnifyContext, Replacements1),
( OldVar = HoistedVar ->
Replacements = Replacements1
;
UnifyContext = unify_context(MainCtxt, SubCtxt),
% It is ok to create complicated unifications here, because we rerun
% mode analysis on the resulting goal. It would be nicer to generate
% the right assignment unification directly, but that would require
% keeping track of the inst of OldVar.
create_pure_atomic_complicated_unification(HoistedVar, rhs_var(OldVar),
Context, MainCtxt, SubCtxt, Goal),
Replacements = [Goal | Replacements1]
).
%-----------------------------------------------------------------------------%
% This section handles the case where the functor involved in the
% common subexpression contains existentially typed arguments,
% whether or not they are constrained to belong to a typeclass.
% In such cases, what the compiler used to consider several distinct
% types (the types of say the first the existentially typed argument
% in the deconstructions in the different branches) become one (in this
% case, the type of the first existentially typed argument in the
% hoisted out deconstruction). The prog_vars describing the types
% of the existentially typed arguments (i.e. containing their
% typeinfos) change as well, from being some of the variables in
% in the original deconstructions to being the corresponding variables
% in the hoisted out deconstruction.
%
% As an example, consider a disjunction such as
%
% (
% HeadVar.g2_2 = x:u(TypeClassInfo_for_v_8, V_4),
% ...
% ;
% HeadVar.g2_2 = x:u(TypeClassInfo_for_v_14, V_6)
% ...
% )
%
% The main part of cse_detection will replace this with
%
% HeadVar.g2_2 = x:u(V_17, V_16)
% (
% TypeClassInfo_for_v_8 = V_17,
% V_4 = V_16,
% ...
% ;
% TypeClassInfo_for_v_14 = V_17,
% V_6 = V_16,
% ...
% )
%
% However, this is not enough. Since TypeClassInfo_for_v_8 and
% TypeClassInfo_for_v_14 may (and probably will) be eliminated later,
% it is imperative that the data structures in the proc_info that refer
% to them be updated to eliminate references to those variables.
% Those data structures may originally contain something like this:
%
% type_info varmap:
% T_1 (number 1) -> typeclass_info(TypeClassInfo_for_v_8, 1)
% T_3 (number 3) -> typeclass_info(TypeClassInfo_for_v_14, 1)
% typeclass_info varmap:
% x:v(T_1) -> TypeClassInfo_for_v_8
% x:v(T_3) -> TypeClassInfo_for_v_14
% variable types map:
% V_4 (number 4) :: T_1
% V_6 (number 6) :: T_3
%
% They must be updated like this:
%
% type_info varmap:
% T_1 (number 1) -> typeclass_info(V_17, 1)
% typeclass_info varmap:
% x:v(T_1) -> V_17
% variable types map:
% V_4 (number 4) :: T_1
% V_6 (number 6) :: T_1
:- pred maybe_update_existential_data_structures(hlds_goal::in,
assoc_list(prog_var)::in, list(assoc_list(prog_var))::in,
cse_info::in, cse_info::out) is det.
maybe_update_existential_data_structures(Unify, FirstOldNew, LaterOldNew,
!CseInfo) :-
(
Unify = hlds_goal(unify(_, _, _, UnifyInfo, _), _),
UnifyInfo = deconstruct(Var, ConsId, _, _, _, _),
ModuleInfo = !.CseInfo ^ module_info,
VarTypes = !.CseInfo ^ vartypes,
map.lookup(VarTypes, Var, Type),
type_util.is_existq_cons(ModuleInfo, Type, ConsId)
->
update_existential_data_structures(FirstOldNew, LaterOldNew, !CseInfo)
;
true
).
:- pred update_existential_data_structures(
assoc_list(prog_var)::in, list(assoc_list(prog_var))::in,
cse_info::in, cse_info::out) is det.
update_existential_data_structures(FirstOldNew, LaterOldNews, !CseInfo) :-
list.condense(LaterOldNews, LaterOldNew),
map.from_assoc_list(FirstOldNew, FirstOldNewMap),
map.from_assoc_list(LaterOldNew, LaterOldNewMap),
RttiVarMaps0 = !.CseInfo ^ rtti_varmaps,
VarTypes0 = !.CseInfo ^ vartypes,
% Build a map for all locations in the rtti_varmaps that are changed
% by the application of FirstOldNewMap. The keys of this map are the
% new locations, and the values are the tvars (from the first branch)
% that have had their locations moved.
%
rtti_varmaps_tvars(RttiVarMaps0, TvarsList),
list.foldl(find_type_info_locn_tvar_map(RttiVarMaps0, FirstOldNewMap),
TvarsList, map.init, NewTvarMap),
% Traverse TVarsList again, this time looking for locations in later
% branches that merge with locations in the first branch. When we find one,
% add a type substitution which represents the type variables that were
% merged.
%
list.foldl(find_merged_tvars(RttiVarMaps0, LaterOldNewMap, NewTvarMap),
TvarsList, map.init, Renaming),
% Apply the full old->new map and the type substitution to the
% rtti_varmaps, and apply the type substitution to the vartypes.
%
list.append(FirstOldNew, LaterOldNew, OldNew),
map.from_assoc_list(OldNew, OldNewMap),
apply_substitutions_to_rtti_varmaps(Renaming, map.init, OldNewMap,
RttiVarMaps0, RttiVarMaps),
map.map_values(apply_tvar_rename(Renaming), VarTypes0, VarTypes),
!:CseInfo = !.CseInfo ^ rtti_varmaps := RttiVarMaps,
!:CseInfo = !.CseInfo ^ vartypes := VarTypes.
:- pred apply_tvar_rename(tvar_renaming::in, prog_var::in,
mer_type::in, mer_type::out) is det.
apply_tvar_rename(Renaming, _Var, Type0, Type) :-
apply_variable_renaming_to_type(Renaming, Type0, Type).
:- pred find_type_info_locn_tvar_map(rtti_varmaps::in,
map(prog_var, prog_var)::in, tvar::in,
map(type_info_locn, tvar)::in, map(type_info_locn, tvar)::out) is det.
find_type_info_locn_tvar_map(RttiVarMaps, FirstOldNewMap, Tvar, !NewTvarMap) :-
rtti_lookup_type_info_locn(RttiVarMaps, Tvar, TypeInfoLocn0),
type_info_locn_var(TypeInfoLocn0, Old),
( map.search(FirstOldNewMap, Old, New) ->
type_info_locn_set_var(New, TypeInfoLocn0, TypeInfoLocn),
svmap.det_insert(TypeInfoLocn, Tvar, !NewTvarMap)
;
true
).
:- pred find_merged_tvars(rtti_varmaps::in, map(prog_var, prog_var)::in,
map(type_info_locn, tvar)::in, tvar::in,
tvar_renaming::in, tvar_renaming::out) is det.
find_merged_tvars(RttiVarMaps, LaterOldNewMap, NewTvarMap, Tvar, !Renaming) :-
rtti_lookup_type_info_locn(RttiVarMaps, Tvar, TypeInfoLocn0),
type_info_locn_var(TypeInfoLocn0, Old),
( map.search(LaterOldNewMap, Old, New) ->
type_info_locn_set_var(New, TypeInfoLocn0, TypeInfoLocn),
map.lookup(NewTvarMap, TypeInfoLocn, NewTvar),
( NewTvar = Tvar ->
true
;
svmap.det_insert(Tvar, NewTvar, !Renaming)
)
;
true
).
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "cse_detection.m".
%-----------------------------------------------------------------------------%
:- end_module cse_detection.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink