Files
mercury/compiler/cse_detection.m
Zoltan Somogyi b4813457c9 A rewrite of termination analysis to make it significantly easier to modify,
Estimated hours taken: 60

A rewrite of termination analysis to make it significantly easier to modify,
and to extend its capabilities.

compiler/error_util.m:
	A new file containing code that makes it easier to generate
	nicely formatted error messages.

compiler/termination.m:
	Updates to reflect the changes to the representation of termination
	information.

	Instead of doing pass 1 on all SCCs and then pass 2 on all SCCs,
	we now do both pass 1 and 2 on an SCC before moving on to the next.

	Do not insist that either all procedures in an SCC are
	compiler-generated or all are user-written, since this need not be
	true in the presence of user-defined equality predicates.

	Clarify the structure of the code that handles builtins and compiler
	generated predicates.

	Concentrate all the code for updating module_infos in this module.
	Previously it was scattered in several places in several files.

	Put all the code for writing out termination information at the
	end of the module in a logical order.

compiler/term_traversal.m:
	A new file containing code used by both pass 1 and pass 2 to
	traverse procedure bodies.

compiler/term_pass1.m:
	Use the new traversal module.

	Clarify the fixpoint computation on the set of output supplier
	arguments.

	Remove duplicates from the list of equations given to the solver.
	This avoids a det stack overflow in lp.m when doing termination
	analysis on options.m.

	If an output argument of a predicate makes sense only in the absence
	of errors, then return it only in the absence of errors.

compiler/term_pass2.m:
	Use the new traversal module. Unlike the previous code, this allows us
	to ignore recursive calls with input arguments bigger than the head
	if those calls occur after goals that cannot succeed (since those
	calls will never be reached).

	Implement a better way of doing single argument analysis, which
	(unlike the previous version) works in the presence of mutual recursion
	and other calls between the recursive call and the start of the clause.

	Implement a more precise way of checking for recursions that don't
	cause termination problems. We now allow calls from p to q in which
	the recursive input supplier arguments can grow, provided that on
	any path on which q can call p, directly or indirectly, the recursive
	input supplier arguments shrink by a greater amount.

	If an output argument of a predicate makes sense only in the absence
	of errors, then return it only in the absence of errors.

compiler/term_util.m:
	Updates to reflect the changes to the representation of termination
	information.

	Reorder to put related code together.

	Change the interface of several predicates to better reflect the
	way they are used.

	Add some more utility predicates.

compiler/term_errors.m:
	Small changes to the set of possible errors, and major changes in
	the way the messages are printed out (we now use error_util).

compiler/options.m:
	Change --term-single-arg from being a bool to an int option,
	whose value indicates the maximum size of an SCC in which we try
	single argument analysis. (Large SCCs can cause single-arg analysis
	to require a lot of iterations.)

	Add an (int) option that controls the max number of paths
	that we are willing to analyze (analyzing too many paths can cause
	det stack overflow).

	Add an (int) option that controls the max number of causes of
	nontermination that we print out.

compiler/hlds_pred.m:
	Use two separate slots in the proc_info to hold argument size data
	and termination info, instead of the single slot used until now.
	The two kinds of information are produced and used separately.

	Make the layout of the get and set procedures for proc_infos more
	regular, to facilitate later updates.

	The procedures proc_info_{,set_}variables did the same work as
	proc_info_{,set_}varset. To eliminate potential confusion, I
	removed the first set.

compiler/*.m:
	Change proc_info_{,set_}variables to proc_info_{,set_}varset.

compiler/hlds_out.m:
compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
	Change the code to handle the arg size data and the termination
	info separately.

compiler/prog_data.m:
	Change the internal representation of termination_info pragmas to
	hold the arg size data and the termination info separately.

compiler/prog_io_pragma.m:
	Change the external representation of termination_info pragmas to
	group the arg size data together with the output supplier data,
	to which it is logically connected.

compiler/module_qual.m:
compiler/modules.m:
	Change the code to accommodate the change to the internal
	representation of termination_info pragmas.

compiler/notes/compiler_design.html:
	Fix some documentation rot, and clarify some points.

	Document termination analysis.

doc/user_guide.texi:
	Document --term-single-arg and the new options.

	Remove spaces from the ends of lines.

library/bag.m:
	Add a new predicate, bag__least_upper_bound.

	Fix code that would do the wrong thing if executed by Prolog.

	Remove spaces from the ends of lines.

library/list.m:
	Add a new predicate, list__take_upto.

library/set{,_ordlist}.m:
	Add a new predicate, set{,_ordlist}__count.

tests/term/*:
	A bunch of new test cases to test the behaviour of termination
	analysis. They are the small benchmark suite from our paper.

tests/Mmakefile:
	Enable the new test case directory.
1997-12-22 10:01:33 +00:00

697 lines
26 KiB
Mathematica

%-----------------------------------------------------------------------------%
% Copyright (C) 1995-1997 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.
%-----------------------------------------------------------------------------%
%
% 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.
%
% Main author: zs.
% Much of the code is based on switch_detection.m by fjh.
%
%-----------------------------------------------------------------------------%
:- module cse_detection.
:- interface.
:- import_module hlds_module, hlds_pred, io.
:- pred detect_cse(module_info, module_info, io__state, io__state).
:- mode detect_cse(in, out, di, uo) is det.
:- pred detect_cse_in_proc(proc_id, pred_id, module_info, module_info,
io__state, io__state).
% :- mode detect_cse_in_proc(in, in, di, uo, di, uo) is det.
:- mode detect_cse_in_proc(in, in, in, out, di, uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_goal, hlds_data, options, globals, goal_util, hlds_out.
:- import_module modes, mode_util, make_hlds, quantification, instmap.
:- import_module prog_data, switch_detection, det_util, inst_match.
:- import_module int, bool, list, map, set, std_util, require, term, varset.
%-----------------------------------------------------------------------------%
% Traverse the module structure, calling `detect_cse_in_goal'
% for each procedure body.
detect_cse(ModuleInfo0, ModuleInfo) -->
{ module_info_predids(ModuleInfo0, PredIds) },
detect_cse_in_preds(PredIds, ModuleInfo0, ModuleInfo).
:- pred detect_cse_in_preds(list(pred_id), module_info, module_info,
io__state, io__state).
:- mode detect_cse_in_preds(in, in, out, di, uo) is det.
detect_cse_in_preds([], ModuleInfo, ModuleInfo) --> [].
detect_cse_in_preds([PredId | PredIds], ModuleInfo0, ModuleInfo) -->
{ module_info_preds(ModuleInfo0, PredTable) },
{ map__lookup(PredTable, PredId, PredInfo) },
detect_cse_in_pred(PredId, PredInfo, ModuleInfo0, ModuleInfo1),
detect_cse_in_preds(PredIds, ModuleInfo1, ModuleInfo).
:- pred detect_cse_in_pred(pred_id, pred_info, module_info, module_info,
io__state, io__state).
:- mode detect_cse_in_pred(in, in, in, out, di, uo) is det.
detect_cse_in_pred(PredId, PredInfo0, ModuleInfo0, ModuleInfo) -->
{ pred_info_non_imported_procids(PredInfo0, ProcIds) },
detect_cse_in_procs(ProcIds, PredId, ModuleInfo0, ModuleInfo).
:- pred detect_cse_in_procs(list(proc_id), pred_id, module_info, module_info,
io__state, io__state).
% :- mode detect_cse_in_procs(in, in, di, uo, di, uo) is det.
:- mode detect_cse_in_procs(in, in, in, out, di, uo) is det.
detect_cse_in_procs([], _PredId, ModuleInfo, ModuleInfo) --> [].
detect_cse_in_procs([ProcId | ProcIds], PredId, ModuleInfo0, ModuleInfo) -->
detect_cse_in_proc(ProcId, PredId, ModuleInfo0, ModuleInfo1),
detect_cse_in_procs(ProcIds, PredId, ModuleInfo1, ModuleInfo).
detect_cse_in_proc(ProcId, PredId, ModuleInfo0, ModuleInfo) -->
{ detect_cse_in_proc_2(ProcId, PredId, Redo, ModuleInfo0,
ModuleInfo1) },
( { Redo = no } ->
{ ModuleInfo = ModuleInfo1 }
;
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
( { VeryVerbose = yes } ->
io__write_string("% Repeating mode check for "),
hlds_out__write_pred_id(ModuleInfo1, PredId),
io__write_string("\n")
;
[]
),
modecheck_proc(ProcId, PredId, ModuleInfo1, ModuleInfo2, Errs),
{ Errs > 0 ->
error("mode check fails when repeated")
;
true
},
( { VeryVerbose = yes } ->
io__write_string("% Repeating switch detection for "),
hlds_out__write_pred_id(ModuleInfo2, PredId),
io__write_string("\n")
;
[]
),
{ detect_switches_in_proc(ProcId, PredId,
ModuleInfo2, ModuleInfo3) },
( { VeryVerbose = yes } ->
io__write_string("% Repeating common deconstruction detection for "),
hlds_out__write_pred_id(ModuleInfo3, PredId),
io__write_string("\n")
;
[]
),
detect_cse_in_proc(ProcId, PredId, ModuleInfo3, ModuleInfo)
).
:- type cse_info ---> cse_info(varset, map(var, type), module_info).
:- pred detect_cse_in_proc_2(proc_id, pred_id, bool, module_info, module_info).
% :- mode detect_cse_in_proc_2(in, in, out, di, uo) is det.
:- mode detect_cse_in_proc_2(in, in, out, in, 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_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_goal(ProcInfo0, Goal0),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
proc_info_varset(ProcInfo0, Varset0),
proc_info_vartypes(ProcInfo0, VarTypes0),
CseInfo0 = cse_info(Varset0, VarTypes0, 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, _),
proc_info_headvars(ProcInfo0, HeadVars),
implicitly_quantify_clause_body(HeadVars, Goal1, Varset1,
VarTypes1, Goal, Varset, VarTypes, _Warnings),
proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
proc_info_set_varset(ProcInfo1, Varset, ProcInfo2),
proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo),
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
module_info_set_preds(ModuleInfo0, PredTable, 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, instmap, cse_info, cse_info,
bool, hlds_goal).
:- mode detect_cse_in_goal(in, in, in, out, out, out) is det.
detect_cse_in_goal(Goal0, InstMap0, CseInfo0, CseInfo, Redo, Goal) :-
detect_cse_in_goal_1(Goal0, InstMap0, CseInfo0, 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, instmap, cse_info, cse_info, bool,
hlds_goal, instmap).
:- mode detect_cse_in_goal_1(in, in, in, out, out, out, out) is det.
detect_cse_in_goal_1(Goal0 - GoalInfo, InstMap0, CseInfo0, CseInfo, Redo,
Goal - GoalInfo, InstMap) :-
detect_cse_in_goal_2(Goal0, GoalInfo, InstMap0, CseInfo0, CseInfo,
Redo, Goal),
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, hlds_goal_info, instmap,
cse_info, cse_info, bool, hlds_goal_expr).
:- mode detect_cse_in_goal_2(in, in, in, in, out, out, out) is det.
detect_cse_in_goal_2(pragma_c_code(A,B,C,D,E,F,G,H), _, _, CseInfo, CseInfo,
no, pragma_c_code(A,B,C,D,E,F,G,H)).
detect_cse_in_goal_2(higher_order_call(A,B,C,D,E,F), _, _, CseInfo, CseInfo,
no, higher_order_call(A,B,C,D,E,F)).
detect_cse_in_goal_2(class_method_call(A,B,C,D,E,F), _, _, CseInfo, CseInfo,
no, class_method_call(A,B,C,D,E,F)).
detect_cse_in_goal_2(call(A,B,C,D,E,F), _, _, CseInfo, CseInfo, no,
call(A,B,C,D,E,F)).
detect_cse_in_goal_2(unify(A,B0,C,D,E), _, InstMap0, CseInfo0, CseInfo, Redo,
unify(A,B,C,D,E)) :-
( B0 = lambda_goal(PredOrFunc, Vars, Modes, Det, Goal0) ->
CseInfo0 = cse_info(_, _, ModuleInfo),
instmap__pre_lambda_update(ModuleInfo,
Vars, Modes, InstMap0, InstMap),
detect_cse_in_goal(Goal0, InstMap, CseInfo0, CseInfo, Redo,
Goal),
B = lambda_goal(PredOrFunc, Vars, Modes, Det, Goal)
;
B = B0,
CseInfo = CseInfo0,
Redo = no
).
detect_cse_in_goal_2(not(Goal0), _GoalInfo, InstMap, CseInfo0, CseInfo,
Redo, not(Goal)) :-
detect_cse_in_goal(Goal0, InstMap, CseInfo0, CseInfo, Redo, Goal).
detect_cse_in_goal_2(some(Vars, Goal0), _GoalInfo, InstMap, CseInfo0, CseInfo,
Redo, some(Vars, Goal)) :-
detect_cse_in_goal(Goal0, InstMap, CseInfo0, CseInfo, Redo, Goal).
detect_cse_in_goal_2(conj(Goals0), _GoalInfo, InstMap, CseInfo0, CseInfo,
Redo, conj(Goals)) :-
detect_cse_in_conj(Goals0, InstMap, CseInfo0, CseInfo, Redo, Goals).
detect_cse_in_goal_2(disj(Goals0, SM), GoalInfo, InstMap, CseInfo0, CseInfo,
Redo, Goal) :-
( Goals0 = [] ->
CseInfo = CseInfo0,
Redo = no,
Goal = disj([], SM)
;
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, NonLocalsList),
detect_cse_in_disj(NonLocalsList, Goals0, GoalInfo,
SM, InstMap, CseInfo0, CseInfo, Redo, Goal)
).
detect_cse_in_goal_2(switch(Var, CanFail, Cases0, SM), GoalInfo, InstMap,
CseInfo0, CseInfo, Redo, Goal) :-
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, NonLocalsList),
detect_cse_in_cases(NonLocalsList, Var, CanFail, Cases0, GoalInfo,
SM, InstMap, CseInfo0, CseInfo, Redo, Goal).
detect_cse_in_goal_2(if_then_else(Vars, Cond0, Then0, Else0, SM), GoalInfo,
InstMap, CseInfo0, 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,
SM, InstMap, CseInfo0, CseInfo, Redo, Goal).
%-----------------------------------------------------------------------------%
:- pred detect_cse_in_conj(list(hlds_goal), instmap, cse_info, cse_info,
bool, list(hlds_goal)).
:- mode detect_cse_in_conj(in, in, in, out, out, out) is det.
detect_cse_in_conj([], _InstMap, CseInfo, CseInfo, no, []).
detect_cse_in_conj([Goal0 | Goals0], InstMap0, CseInfo0, CseInfo,
Redo, Goals) :-
detect_cse_in_goal_1(Goal0, InstMap0, CseInfo0, CseInfo1, Redo1, Goal1,
InstMap1),
detect_cse_in_conj(Goals0, InstMap1, CseInfo1, CseInfo, Redo2, Goals1),
( Goal1 = conj(ConjGoals) - _ ->
list__append(ConjGoals, Goals1, Goals)
;
Goals = [Goal1 | Goals1]
),
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(var), list(hlds_goal), hlds_goal_info,
store_map, instmap, cse_info, cse_info, bool, hlds_goal_expr).
:- mode detect_cse_in_disj(in, in, in, in, in, in, out, out, out) is det.
detect_cse_in_disj([], Goals0, _, SM, InstMap, CseInfo0, CseInfo,
Redo, disj(Goals, SM)) :-
detect_cse_in_disj_2(Goals0, InstMap, CseInfo0, CseInfo, Redo, Goals).
detect_cse_in_disj([Var | Vars], Goals0, GoalInfo0, SM, InstMap,
CseInfo0, CseInfo, Redo, Goal) :-
(
instmap__lookup_var(InstMap, Var, VarInst0),
CseInfo0 = cse_info(_, _, ModuleInfo),
% 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, CseInfo0, CseInfo1,
Unify, Goals)
->
CseInfo = CseInfo1,
Goal = conj([Unify, disj(Goals, SM) - GoalInfo0]),
Redo = yes
;
detect_cse_in_disj(Vars, Goals0, GoalInfo0, SM, InstMap,
CseInfo0, CseInfo, Redo, Goal)
).
:- pred detect_cse_in_disj_2(list(hlds_goal), instmap, cse_info, cse_info,
bool, list(hlds_goal)).
:- mode detect_cse_in_disj_2(in, in, in, out, out, out) is det.
detect_cse_in_disj_2([], _InstMap, CseInfo, CseInfo, no, []).
detect_cse_in_disj_2([Goal0 | Goals0], InstMap0, CseInfo0, CseInfo, Redo,
[Goal | Goals]) :-
detect_cse_in_goal(Goal0, InstMap0, CseInfo0, CseInfo1, Redo1, Goal),
detect_cse_in_disj_2(Goals0, InstMap0, CseInfo1, CseInfo, Redo2, Goals),
bool__or(Redo1, Redo2, Redo).
:- pred detect_cse_in_cases(list(var), var, can_fail, list(case),
hlds_goal_info, store_map, instmap, cse_info, cse_info, bool,
hlds_goal_expr).
:- mode detect_cse_in_cases(in, in, in, in, in, in, in, in, out, out, out)
is det.
detect_cse_in_cases([], SwitchVar, CanFail, Cases0, _GoalInfo, SM, InstMap,
CseInfo0, CseInfo, Redo,
switch(SwitchVar, CanFail, Cases, SM)) :-
detect_cse_in_cases_2(Cases0, InstMap, CseInfo0, CseInfo, Redo, Cases).
detect_cse_in_cases([Var | Vars], SwitchVar, CanFail, Cases0, GoalInfo,
SM, InstMap, CseInfo0, CseInfo, Redo, Goal) :-
(
Var \= SwitchVar,
instmap__lookup_var(InstMap, Var, VarInst0),
CseInfo0 = cse_info(_, _, ModuleInfo),
% 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, CseInfo0, CseInfo1,
Unify, Cases)
->
CseInfo = CseInfo1,
Goal = conj([Unify, switch(SwitchVar, CanFail, Cases, SM)
- GoalInfo]),
Redo = yes
;
detect_cse_in_cases(Vars, SwitchVar, CanFail, Cases0, GoalInfo,
SM, InstMap, CseInfo0, CseInfo, Redo, Goal)
).
:- pred detect_cse_in_cases_2(list(case), instmap, cse_info, cse_info,
bool, list(case)).
:- mode detect_cse_in_cases_2(in, in, in, out, out, out) is det.
detect_cse_in_cases_2([], _, CseInfo, CseInfo, no, []).
detect_cse_in_cases_2([Case0 | Cases0], InstMap, CseInfo0, CseInfo, Redo,
[Case | Cases]) :-
Case0 = case(Functor, Goal0),
detect_cse_in_goal(Goal0, InstMap, CseInfo0, CseInfo1, Redo1, Goal),
Case = case(Functor, Goal),
detect_cse_in_cases_2(Cases0, InstMap, CseInfo1, CseInfo, Redo2, Cases),
bool__or(Redo1, Redo2, Redo).
:- pred detect_cse_in_ite(list(var), list(var),
hlds_goal, hlds_goal, hlds_goal, hlds_goal_info,
store_map, instmap, cse_info, cse_info, bool, hlds_goal_expr).
:- mode detect_cse_in_ite(in, in, in, in, in, in, in, in, in, out, out, out)
is det.
detect_cse_in_ite([], IfVars, Cond0, Then0, Else0, _, SM, InstMap, CseInfo0,
CseInfo, Redo, if_then_else(IfVars, Cond, Then, Else, SM)) :-
detect_cse_in_ite_2(Cond0, Then0, Else0,
InstMap, CseInfo0, CseInfo, Redo, Cond, Then, Else).
detect_cse_in_ite([Var | Vars], IfVars, Cond0, Then0, Else0, GoalInfo,
SM, InstMap, CseInfo0, CseInfo, Redo, Goal) :-
(
CseInfo0 = cse_info(_, _, ModuleInfo),
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, CseInfo0, CseInfo1,
Unify, Goals),
Goals = [Then, Else]
->
CseInfo = CseInfo1,
Goal = conj([Unify, if_then_else(IfVars, Cond0, Then, Else, SM)
- GoalInfo]),
Redo = yes
;
detect_cse_in_ite(Vars, IfVars, Cond0, Then0, Else0, GoalInfo,
SM, InstMap, CseInfo0, CseInfo, Redo, Goal)
).
:- pred detect_cse_in_ite_2(hlds_goal, hlds_goal, hlds_goal,
instmap, cse_info, cse_info, bool, hlds_goal, hlds_goal, hlds_goal).
:- mode detect_cse_in_ite_2(in, in, in, in, in, out, out, out, out, out) is det.
detect_cse_in_ite_2(Cond0, Then0, Else0, InstMap0, CseInfo0, CseInfo, Redo,
Cond, Then, Else) :-
detect_cse_in_goal_1(Cond0, InstMap0, CseInfo0, CseInfo1, Redo1, Cond,
InstMap1),
detect_cse_in_goal(Then0, InstMap1, CseInfo1, CseInfo2, Redo2, Then),
detect_cse_in_goal(Else0, InstMap0, CseInfo2, CseInfo, Redo3, Else),
bool__or(Redo1, Redo2, Redo12),
bool__or(Redo12, Redo3, Redo).
%-----------------------------------------------------------------------------%
% common_deconstruct(Goals0, Var, CseInfo0, 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.
% CseInfo0 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), var, cse_info, cse_info,
hlds_goal, list(hlds_goal)).
:- mode common_deconstruct(in, in, in, out, out, out) is semidet.
common_deconstruct(Goals0, Var, CseInfo0, CseInfo, Unify, Goals) :-
common_deconstruct_2(Goals0, Var, no, CseInfo0, CseInfo,
Goals, MaybeUnifyGoal),
MaybeUnifyGoal = yes(Unify).
:- pred common_deconstruct_2(list(hlds_goal), var, maybe(hlds_goal),
cse_info, cse_info, list(hlds_goal), maybe(hlds_goal)).
:- mode common_deconstruct_2(in, in, in, in, out, out, out) is semidet.
common_deconstruct_2([], _Var, MaybeUnify, CseInfo, CseInfo, [], MaybeUnify).
common_deconstruct_2([Goal0 | Goals0], Var, MaybeUnify0,
CseInfo0, CseInfo, [Goal | Goals], MaybeUnify) :-
goal_to_conj_list(Goal0, ConjList0),
Goal0 = _ - GoalInfo,
map__init(Substitution),
find_bind_var_for_cse(ConjList0, Substitution, Var, MaybeUnify0,
CseInfo0, CseInfo1, ConjList, _NewSubstitution, MaybeUnify1),
MaybeUnify1 = yes(_),
conj_list_to_goal(ConjList, GoalInfo, Goal),
common_deconstruct_2(Goals0, Var, MaybeUnify1, CseInfo1, CseInfo,
Goals, MaybeUnify).
%-----------------------------------------------------------------------------%
:- pred common_deconstruct_cases(list(case), var, cse_info, cse_info,
hlds_goal, list(case)).
:- mode common_deconstruct_cases(in, in, in, out, out, out) is semidet.
common_deconstruct_cases(Cases0, Var, CseInfo0, CseInfo,
Unify, Cases) :-
common_deconstruct_cases_2(Cases0, Var, no, CseInfo0, CseInfo,
Cases, MaybeUnifyGoal),
MaybeUnifyGoal = yes(Unify).
:- pred common_deconstruct_cases_2(list(case), var, maybe(hlds_goal),
cse_info, cse_info, list(case), maybe(hlds_goal)).
:- mode common_deconstruct_cases_2(in, in, in, in, out, out, out) is semidet.
common_deconstruct_cases_2([], _Var, MaybeUnify, CseInfo, CseInfo,
[], MaybeUnify).
common_deconstruct_cases_2([case(ConsId, Goal0) | Cases0], Var, MaybeUnify0,
CseInfo0, CseInfo, [case(ConsId, Goal) | Cases], MaybeUnify) :-
goal_to_conj_list(Goal0, ConjList0),
Goal0 = _ - GoalInfo,
map__init(Substitution),
find_bind_var_for_cse(ConjList0, Substitution, Var, MaybeUnify0,
CseInfo0, CseInfo1, ConjList, _NewSubstitution, MaybeUnify1),
MaybeUnify1 = yes(_),
conj_list_to_goal(ConjList, GoalInfo, Goal),
common_deconstruct_cases_2(Cases0, Var, MaybeUnify1, CseInfo1, CseInfo,
Cases, MaybeUnify).
%-----------------------------------------------------------------------------%
% Searches through Goals0 looking for a deconstruction
% unification with `Var'.
%
% If MaybeUnify0 is no, a unification with any functor
% is acceptable; if it is yes(Unify), only a unification
% involving the same variable and function symbol is OK.
%
% If we do find an acceptable deconstruction, we replace it
% in the goal with pairwise equalities between the arguments
% of the functor in that unification and the arguments of the
% functor in Unify, where in Maybeunify = yes(Unify).
% If MaybeUnify0 was no, we have to create the variables in Unify.
%
% If we do not find an acceptable deconstruction, we set
% MaybeUnify to no and set `Subst' to the substitution resulting
% from interpreting through the goal.
:- pred find_bind_var_for_cse(list(hlds_goal), substitution, var,
maybe(hlds_goal), cse_info, cse_info, list(hlds_goal),
substitution, maybe(hlds_goal)).
:- mode find_bind_var_for_cse(in, in, in, in, in, out, out, out, out) is det.
find_bind_var_for_cse([], Substitution, _Var, _MaybeUnify0, CseInfo, CseInfo,
[], Substitution, no).
find_bind_var_for_cse([GoalPair0 | Goals0], Substitution0, Var, MaybeUnify0,
CseInfo0, CseInfo, Goals, Substitution, MaybeUnify) :-
GoalPair0 = Goal0 - GoalInfo,
( Goal0 = conj(SubGoals0) ->
find_bind_var_for_cse(SubGoals0, Substitution0, Var,
MaybeUnify0, CseInfo0, CseInfo1,
SubGoals, Substitution1, MaybeUnify1),
Goal = conj(SubGoals),
( MaybeUnify1 = yes(_) ->
Goals = [Goal - GoalInfo | Goals0],
Substitution = Substitution1,
MaybeUnify = MaybeUnify1,
CseInfo = CseInfo1
;
find_bind_var_for_cse(Goals0, Substitution1, Var,
MaybeUnify0, CseInfo1, CseInfo,
Goals1, Substitution, MaybeUnify),
Goals = [Goal0 - GoalInfo | Goals1]
)
; Goal0 = unify(A, B, _, UnifyInfo0, _) ->
term__apply_rec_substitution(term__variable(Var),
Substitution0, Term),
(
Term = term__variable(Var1),
UnifyInfo0 = deconstruct(UnifyVar, _, _, _, _),
term__apply_rec_substitution(term__variable(UnifyVar),
Substitution0, term__variable(UnifyVar1)),
Var1 = UnifyVar1,
MaybeUnify0 = no
->
CseInfo0 = cse_info(Varset0, Typemap0, ModuleInfo),
construct_common_unify(Var, Goal0 - GoalInfo, Goal,
Varset0, Varset, Typemap0, Typemap,
Replacements),
CseInfo = cse_info(Varset, Typemap, ModuleInfo),
MaybeUnify = yes(Goal),
list__append(Replacements, Goals0, Goals),
Substitution = Substitution0
;
Term = term__variable(Var1),
UnifyInfo0 = deconstruct(UnifyVar, _, _, _, _),
term__apply_rec_substitution(term__variable(UnifyVar),
Substitution0, term__variable(UnifyVar1)),
Var1 = UnifyVar1,
UnifyInfo0 = deconstruct(_, _, _, _, _),
MaybeUnify0 = yes(OldUnifyGoal),
goal_info_get_context(GoalInfo, Context),
find_similar_deconstruct(OldUnifyGoal, UnifyInfo0,
Context, Replacements)
->
list__append(Replacements, Goals0, Goals),
Substitution = Substitution0,
CseInfo = CseInfo0,
MaybeUnify = MaybeUnify0
;
%
% if the variable was bound, but the deconstruction wasn't
% similar, then stop searching
%
Term = term__functor(_, _, _)
->
Goals = [Goal0 - GoalInfo | Goals0],
Substitution = Substitution0,
CseInfo = CseInfo0,
MaybeUnify = no
;
( interpret_unify(A, B, Substitution0, Substitution1) ->
Substitution2 = Substitution1
;
% the unification must fail - just ignore it
Substitution2 = Substitution0
),
find_bind_var_for_cse(Goals0, Substitution2, Var,
MaybeUnify0, CseInfo0, CseInfo,
Goals1, Substitution, MaybeUnify),
Goals = [Goal0 - GoalInfo | Goals1]
)
;
Goals = [Goal0 - GoalInfo | Goals0],
Substitution = Substitution0,
CseInfo = CseInfo0,
MaybeUnify = no
).
:- pred construct_common_unify(var, hlds_goal, hlds_goal, varset, varset,
map(var, type), map(var, type), list(hlds_goal)).
:- mode construct_common_unify(in, in, out, in, out, in, out, out) is det.
construct_common_unify(Var, GoalExpr0 - GoalInfo, Goal, Varset0, Varset,
Typemap0, Typemap, Replacements) :-
(
GoalExpr0 = unify(_, Term, Umode, Unif0, Ucontext),
Unif0 = deconstruct(_, Consid, Args, Submodes, CanFail)
->
Unif = deconstruct(Var, Consid, Args, Submodes, CanFail),
( Term = functor(_, _) ->
GoalExpr1 = unify(Var, Term, Umode, Unif, Ucontext)
;
error("unexpected unify structure in construct_common_unify")
),
goal_info_get_context(GoalInfo, Context),
create_parallel_subterms(Args, Context, Ucontext,
Varset0, Varset, Typemap0, Typemap, Sub, Replacements),
goal_util__rename_vars_in_goal(GoalExpr1 - GoalInfo, Sub, Goal)
;
error("unexpected goal in construct_common_unify")
).
:- pred create_parallel_subterms(list(var), term__context, unify_context,
varset, varset, map(var, type), map(var, type), map(var, var),
list(hlds_goal)).
:- mode create_parallel_subterms(in, in, in, in, out, in, out, out, out) is det.
create_parallel_subterms([], _, _, Varset, Varset, Typemap, Typemap, Sub, []) :-
map__init(Sub).
create_parallel_subterms([OFV | OFV0], Context, UnifyContext, Varset0, Varset,
Typemap0, Typemap, Sub, Replacements) :-
create_parallel_subterms(OFV0, Context, UnifyContext, Varset0, Varset1,
Typemap0, Typemap1, Sub1, Replacements1),
varset__new_var(Varset1, NFV, Varset),
map__lookup(Typemap1, OFV, Type),
map__det_insert(Typemap1, NFV, Type, Typemap),
map__det_insert(Sub1, OFV, NFV, Sub),
UnifyContext = unify_context(MainCtxt, SubCtxt),
create_atomic_unification(OFV, var(NFV),
Context, MainCtxt, SubCtxt, Goal),
Replacements = [Goal | Replacements1].
%-----------------------------------------------------------------------------%
:- pred find_similar_deconstruct(hlds_goal, unification, term__context,
list(hlds_goal)).
:- mode find_similar_deconstruct(in, in, in, out) is semidet.
find_similar_deconstruct(OldUnifyGoal, NewUnifyInfo, Context, Replacements) :-
(
OldUnifyGoal = unify(_OT1, _OT2, _OM, OldUnifyInfo, OC) - _,
OldUnifyInfo = deconstruct(_OV, OF, OFV, _OUM, _OCF),
NewUnifyInfo = deconstruct(_NV, NF, NFV, _NUM, _NCF)
->
OF = NF,
list__length(OFV, OFVC),
list__length(NFV, NFVC),
OFVC = NFVC,
pair_subterms(OFV, NFV, Context, OC, Replacements)
;
error("find_similar_deconstruct: non-deconstruct unify")
).
:- pred pair_subterms(list(var), list(var), term__context, unify_context,
list(hlds_goal)).
:- mode pair_subterms(in, in, in, in, out) is det.
pair_subterms(OFV0, NFV0, Context, UnifyContext, Replacements) :-
(
OFV0 = [OFV | OFV1],
NFV0 = [NFV | NFV1]
->
pair_subterms(OFV1, NFV1, Context, UnifyContext, Replacements1),
( OFV = NFV ->
Replacements = Replacements1
;
UnifyContext = unify_context(MainCtxt, SubCtxt),
create_atomic_unification(OFV, var(NFV),
Context, MainCtxt, SubCtxt, Goal),
Replacements = [Goal | Replacements1]
)
;
OFV0 = [],
NFV0 = []
->
Replacements = []
;
error("mismatched length lists in pair_subterms")
).
%-----------------------------------------------------------------------------%