mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-13 12:53:53 +00:00
Code Issues Projects Releases Wiki Activity

Require only pulled-out functors' args to be non-unique.

Browse Source 
This fixes the general case of Mantis bug 480.

compiler/cse_detection.m:
    When deciding whether we want to pull common X = f(...) unifications
    out of branched control structures, require only f'a args to be nonunique,
    not the args of any other functors that X may be bound to.

compiler/switch_detection.m:
    Obey the restrictions that cse_detection.m may impose.

tests/valid/bug480a.m:
    A new test case for this bug fix.

tests/valid/Mmakefile:
    Enable the new test case.
This commit is contained in:
Zoltan Somogyi
2019-08-07 14:59:40 +02:00
parent bd369d63be
commit 779e1ce54a
4 changed files with 166 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

110
compiler/cse_detection.m
View File

@@ -119,6 +119,7 @@
:- import_module map.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
:- import_module varset.
@@ -535,8 +536,8 @@ detect_cse_in_disj([Var | Vars], Goals0, GoalInfo0, InstMap0,
!CseInfo, GoalExpr) :-
instmap_lookup_var(InstMap0, Var, VarInst0),
( if
may_pull_lhs_inst(!.CseInfo, VarInst0),
common_deconstruct(Goals0, Var, !CseInfo, UnifyGoal,
may_pull_lhs_inst(!.CseInfo, VarInst0, MayPull),
common_deconstruct(Goals0, Var, MayPull, !CseInfo, UnifyGoal,
FirstOldNew, LaterOldNew, Goals)
then
maybe_update_existential_data_structures(UnifyGoal,
@@ -572,8 +573,8 @@ detect_cse_in_cases([Var | Vars], SwitchVar, CanFail, Cases0, GoalInfo,
( if
Var \= SwitchVar,
instmap_lookup_var(InstMap0, Var, VarInst0),
may_pull_lhs_inst(!.CseInfo, VarInst0),
common_deconstruct_cases(Cases0, Var, !CseInfo,
may_pull_lhs_inst(!.CseInfo, VarInst0, MayPull),
common_deconstruct_cases(Cases0, Var, MayPull, !CseInfo,
UnifyGoal, FirstOldNew, LaterOldNew, Cases)
then
maybe_update_existential_data_structures(UnifyGoal,
@@ -610,8 +611,8 @@ detect_cse_in_ite([Var | Vars], IfVars, Cond0, Then0, Else0, GoalInfo,
InstMap, !CseInfo, GoalExpr) :-
instmap_lookup_var(InstMap, Var, VarInst0),
( if
may_pull_lhs_inst(!.CseInfo, VarInst0),
common_deconstruct([Then0, Else0], Var, !CseInfo,
may_pull_lhs_inst(!.CseInfo, VarInst0, MayPull),
common_deconstruct([Then0, Else0], Var, MayPull, !CseInfo,
UnifyGoal, FirstOldNew, LaterOldNew, Goals),
Goals = [Then, Else]
then
@@ -638,11 +639,12 @@ detect_cse_in_ite_arms(Cond0, Cond, Then0, Then, Else0, Else, !CseInfo,
%---------------------------------------------------------------------------%
% common_deconstruct(Goals0, Var, !CseInfo, Unify, Goals):
% common_deconstruct(Goals0, Var, MayPull, !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.
% MayPull says which Var = cons_id(...) unifications we may pull out.
% !.CseInfo contains the original varset and type map.
% output vars:
% !:CseInfo has a varset and a type map reflecting the new variables
@@ -651,53 +653,54 @@ detect_cse_in_ite_arms(Cond0, Cond, Then0, Then, Else0, Else, !CseInfo,
% 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,
:- pred common_deconstruct(list(hlds_goal)::in, prog_var::in, may_pull::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,
common_deconstruct(Goals0, Var, MayPull, !CseInfo, Unify,
FirstOldNew, LaterOldNew, Goals) :-
common_deconstruct_2(Goals0, Var, MayPull, before_candidate,
have_candidate(Unify, FirstOldNew, LaterOldNew), !CseInfo, Goals),
LaterOldNew = [_ | _].
:- pred common_deconstruct_2(list(hlds_goal)::in, prog_var::in,
:- pred common_deconstruct_2(list(hlds_goal)::in, prog_var::in, may_pull::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,
common_deconstruct_2([], _Var, _MayPull, !CseState, !CseInfo, []).
common_deconstruct_2([Goal0 | Goals0], Var, MayPull, !CseState, !CseInfo,
[Goal | Goals]) :-
find_bind_var(Var, find_bind_var_for_cse_in_deconstruct, Goal0, Goal,
!CseState, !CseInfo, did_find_deconstruct),
find_bind_var(Var, MayPull, find_bind_var_for_cse_in_deconstruct,
Goal0, Goal, !CseState, !CseInfo, did_find_deconstruct),
!.CseState = have_candidate(_, _, _),
common_deconstruct_2(Goals0, Var, !CseState, !CseInfo, Goals).
common_deconstruct_2(Goals0, Var, MayPull, !CseState, !CseInfo, Goals).
%---------------------------------------------------------------------------%
:- pred common_deconstruct_cases(list(case)::in, prog_var::in,
:- pred common_deconstruct_cases(list(case)::in, prog_var::in, may_pull::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,
common_deconstruct_cases(Cases0, Var, MayPull, !CseInfo, Unify,
FirstOldNew, LaterOldNew, Cases) :-
common_deconstruct_cases_2(Cases0, Var, before_candidate,
common_deconstruct_cases_2(Cases0, Var, MayPull, before_candidate,
have_candidate(Unify, FirstOldNew, LaterOldNew), !CseInfo, Cases),
LaterOldNew = [_ | _].
:- pred common_deconstruct_cases_2(list(case)::in, prog_var::in,
:- pred common_deconstruct_cases_2(list(case)::in, prog_var::in, may_pull::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([Case0 | Cases0], Var, !CseState, !CseInfo,
common_deconstruct_cases_2([], _Var, _MayPull, !CseState, !CseInfo, []).
common_deconstruct_cases_2([Case0 | Cases0], Var, MayPull, !CseState, !CseInfo,
[Case | Cases]) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
find_bind_var(Var, find_bind_var_for_cse_in_deconstruct, Goal0, Goal,
!CseState, !CseInfo, did_find_deconstruct),
find_bind_var(Var, MayPull, find_bind_var_for_cse_in_deconstruct,
Goal0, Goal, !CseState, !CseInfo, did_find_deconstruct),
Case = case(MainConsId, OtherConsIds, Goal),
!.CseState = have_candidate(_, _, _),
common_deconstruct_cases_2(Cases0, Var, !CseState, !CseInfo, Cases).
common_deconstruct_cases_2(Cases0, Var, MayPull,
!CseState, !CseInfo, Cases).
%---------------------------------------------------------------------------%
@@ -1076,9 +1079,10 @@ find_merged_tvars(RttiVarMaps, LaterOldNewMap, NewTvarMap, Tvar, !Renaming) :-
% variable has this inst out of two or more arms, to put before
% the disjunction, switch or if-then-else?
%
:- pred may_pull_lhs_inst(cse_info::in, mer_inst::in) is semidet.
:- pred may_pull_lhs_inst(cse_info::in, mer_inst::in, may_pull::out)
is semidet.
may_pull_lhs_inst(CseInfo, VarInst) :-
may_pull_lhs_inst(CseInfo, VarInst, MayPull) :-
ModuleInfo = CseInfo ^ csei_module_info,
% XXX We only need inst_is_bound, but leave this as it is until
% mode analysis can handle aliasing between free variables.
@@ -1091,24 +1095,38 @@ may_pull_lhs_inst(CseInfo, VarInst) :-
% We only need the insts of the *arguments* to be free of uniqueness.
% However, the vast majority of the time, the whole inst is free
% of uniqueness, so for efficiency in the common case, we test that first.
(
inst_is_not_partly_unique(ModuleInfo, VarInst)
;
( if inst_is_not_partly_unique(ModuleInfo, VarInst) then
MayPull = may_pull_all_functors
else
inst_is_bound_to_functors(ModuleInfo, VarInst, FunctorBoundInsts),
% XXX Ideally, we should test only whether the arguments
% of the *specific cons_id* we want to pull out of the disjunction
% are free of unique components. However, our caller calls us
% *before* we enter the disjunction, and thus it does not know
% the cons_id yet. And the vast majority of the time, FunctorBoundInsts
% contains only one bound inst anyway. If it is the one that
% we will end up pulling out of the disjunction, we do the right
% thing here; if it isn't, we won't pull it out of the disjunction.
% Either way, we do the right thing. We can be overly cautious
% here only if FunctorBoundInsts contains two or more elements.
ArgInstLists = list.map((func(bound_functor(_, Args)) = Args),
FunctorBoundInsts),
list.condense(ArgInstLists, ArgInsts),
list.all_true(inst_is_not_partly_unique(ModuleInfo), ArgInsts)
may_pull_which_functors(ModuleInfo, FunctorBoundInsts,
MayPullConsIds, MayNotPullConsIds),
% Fail if there are *no* constructors we may pull.
MayPullConsIds = [_ | _],
(
MayNotPullConsIds = [],
MayPull = may_pull_all_functors
;
MayNotPullConsIds = [_ | _],
MayPull = may_pull_some_functors(set.list_to_set(MayPullConsIds))
)
).
:- pred may_pull_which_functors(module_info::in, list(bound_inst)::in,
list(cons_id)::out, list(cons_id)::out) is det.
may_pull_which_functors(_, [], [], []).
may_pull_which_functors(ModuleInfo, [BoundInst | BoundInsts],
MayPullConsIds, MayNotPullConsIds) :-
may_pull_which_functors(ModuleInfo, BoundInsts,
TailMayPullConsIds, TailMayNotPullConsIds),
BoundInst = bound_functor(ConsId, ArgInsts),
( if list.all_true(inst_is_not_partly_unique(ModuleInfo), ArgInsts) then
MayPullConsIds = [ConsId | TailMayPullConsIds],
MayNotPullConsIds = TailMayNotPullConsIds
else
MayPullConsIds = TailMayPullConsIds,
MayNotPullConsIds = [ConsId | TailMayNotPullConsIds]
).
%---------------------------------------------------------------------------%

86
compiler/switch_detection.m
View File

@@ -27,6 +27,7 @@
:- import_module parse_tree.prog_data.
:- import_module list.
:- import_module set.
%-----------------------------------------------------------------------------%
@@ -43,18 +44,26 @@
---> did_find_deconstruct
; did_not_find_deconstruct.
% find_bind_var(Var, ProcessUnify, Goal0, Goal, !Result, !Info,
% Which unifications are we allowed to pull out of a branched control
% structure? Maybe all unifications with the given variable, maybe just
% those which unify that variable with one of the given cons_ids.
:- type may_pull
---> may_pull_all_functors
; may_pull_some_functors(set(cons_id)).
% find_bind_var(Var, MayPull, 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 find_bind_var finds a deconstruction unification
% of the variable, it calls ProcessUnify to handle it (which may replace
% the unification with some other goals, which is why we return Goal),
% and it stops searching. If it doesn't find such a deconstruction,
% find_bind_var leaves !Result unchanged.
% of the variable, and if it is with a cons_id that is allowed by MayPull,
% it calls ProcessUnify to handle it (which may replace the unification
% with some other goals, which is why we return Goal), and it stops
% searching. If it doesn't find such a deconstruction, find_bind_var
% leaves !Result unchanged.
%
:- pred find_bind_var(prog_var::in,
:- pred find_bind_var(prog_var::in, may_pull::in,
process_unify(Result, Info)::in(process_unify),
hlds_goal::in, hlds_goal::out, Result::in, Result::out,
Info::in, Info::out, found_deconstruct::out) is det.
@@ -91,7 +100,6 @@
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module set_tree234.
:- import_module term.
:- import_module unit.
@@ -1095,8 +1103,8 @@ select_best_candidate_switch([Candidate | Candidates], !BestCandidate) :-
% 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, list(case)::out,
:- pred partition_disj(list(hlds_goal)::in, prog_var::in,
hlds_goal_info::in, list(hlds_goal)::out, list(case)::out,
local_switch_detect_info::in, local_switch_detect_info::out) is semidet.
partition_disj(Disjuncts0, Var, GoalInfo, Left, Cases, !LocalInfo) :-
@@ -1237,8 +1245,9 @@ create_expanded_conjunction(Unifies, LaterGoals, GoalInfo, Disjunct, Goal) :-
partition_disj_trial([], _Var, !Left, !CasesTable).
partition_disj_trial([Disjunct0 | Disjuncts0], Var, !Left, !CasesTable) :-
find_bind_var(Var, find_bind_var_for_switch_in_deconstruct, Disjunct0,
Disjunct, no, MaybeConsId, unit, _, _),
find_bind_var(Var, may_pull_all_functors,
find_bind_var_for_switch_in_deconstruct, Disjunct0, Disjunct,
no, MaybeConsId, unit, _, _),
(
MaybeConsId = yes(ConsId),
add_single_entry(ConsId, Disjunct, !CasesTable)
@@ -1284,10 +1293,11 @@ find_bind_var_for_switch_in_deconstruct(SwitchVar, Goal0, Goals,
%-----------------------------------------------------------------------------%
find_bind_var(Var, ProcessUnify, !Goal, !Result, !Info, FoundDeconstruct) :-
find_bind_var(Var, MayPull, ProcessUnify, !Goal, !Result, !Info,
FoundDeconstruct) :-
map.init(Subst),
find_bind_var_2(Var, ProcessUnify, !Goal, Subst, _, !Result, !Info,
DeconstructSearch),
find_bind_var_2(Var, MayPull, ProcessUnify, !Goal, Subst, _,
!Result, !Info, DeconstructSearch),
(
DeconstructSearch = before_deconstruct,
FoundDeconstruct = did_not_find_deconstruct
@@ -1304,14 +1314,14 @@ find_bind_var(Var, ProcessUnify, !Goal, !Result, !Info, FoundDeconstruct) :-
; found_deconstruct
; given_up_search.
:- pred find_bind_var_2(prog_var::in,
:- pred find_bind_var_2(prog_var::in, may_pull::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) :-
find_bind_var_2(Var, MayPull, ProcessUnify, Goal0, Goal, !Subst,
!Result, !Info, FoundDeconstruct) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
(
GoalExpr0 = scope(Reason0, SubGoal0),
@@ -1324,8 +1334,8 @@ find_bind_var_2(Var, ProcessUnify, Goal0, Goal, !Subst, !Result, !Info,
% we keep going.
FoundDeconstruct = before_deconstruct
else
find_bind_var_2(Var, ProcessUnify, SubGoal0, SubGoal, !Subst,
!Result, !Info, FoundDeconstruct),
find_bind_var_2(Var, MayPull, ProcessUnify, SubGoal0, SubGoal,
!Subst, !Result, !Info, FoundDeconstruct),
( if
FoundDeconstruct = found_deconstruct,
Reason0 = from_ground_term(_, from_ground_term_deconstruct)
@@ -1347,8 +1357,9 @@ find_bind_var_2(Var, ProcessUnify, Goal0, Goal, !Subst, !Result, !Info,
FoundDeconstruct = before_deconstruct
;
SubGoals0 = [_ | _],
conj_find_bind_var(Var, ProcessUnify, SubGoals0, SubGoals,
!Subst, !Result, !Info, FoundDeconstruct),
conj_find_bind_var(Var, MayPull, ProcessUnify,
SubGoals0, SubGoals, !Subst, !Result, !Info,
FoundDeconstruct),
Goal = hlds_goal(conj(ConjType, SubGoals), GoalInfo)
)
;
@@ -1361,14 +1372,22 @@ find_bind_var_2(Var, ProcessUnify, Goal0, Goal, !Subst, !Result, !Info,
( if
% Check whether the unification is a deconstruction unification
% on either Var or on a variable aliased to Var.
UnifyInfo0 = deconstruct(UnifyVar, _, _, _, _, _),
UnifyInfo0 = deconstruct(UnifyVar, ConsId, _, _, _, _),
term.apply_rec_substitution_in_term(!.Subst,
term.variable(Var, context_init),
term.variable(SubstVar, context_init)),
term.variable(Var, term.context_init),
term.variable(SubstVar, term.context_init)),
term.apply_rec_substitution_in_term(!.Subst,
term.variable(UnifyVar, context_init),
term.variable(SubstUnifyVar, context_init)),
SubstVar = SubstUnifyVar
term.variable(UnifyVar, term.context_init),
term.variable(SubstUnifyVar, term.context_init)),
SubstVar = SubstUnifyVar,
% Check whether we may pull this unification out of the branched
% control structure it is in.
(
MayPull = may_pull_all_functors
;
MayPull = may_pull_some_functors(AllowedConsIds),
set.contains(AllowedConsIds, ConsId)
)
then
call(ProcessUnify, Var, Goal0, Goals, !Result, !Info),
conj_list_to_goal(Goals, GoalInfo, Goal),
@@ -1415,21 +1434,22 @@ find_bind_var_2(Var, ProcessUnify, Goal0, Goal, !Subst, !Result, !Info,
)
).
:- pred conj_find_bind_var(prog_var::in,
:- pred conj_find_bind_var(prog_var::in, may_pull::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,
conj_find_bind_var(_Var, _MayPull, _, [], [], !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,
conj_find_bind_var(Var, MayPull, ProcessUnify,
[Goal0 | Goals0], [Goal | Goals], !Subst, !Result, !Info,
FoundDeconstruct) :-
find_bind_var_2(Var, MayPull, ProcessUnify, Goal0, Goal, !Subst,
!Result, !Info, FoundDeconstruct1),
(
FoundDeconstruct1 = before_deconstruct,
conj_find_bind_var(Var, ProcessUnify, Goals0, Goals,
conj_find_bind_var(Var, MayPull, ProcessUnify, Goals0, Goals,
!Subst, !Result, !Info, FoundDeconstruct)
;
( FoundDeconstruct1 = found_deconstruct

1
tests/valid/Mmakefile
View File

@@ -86,6 +86,7 @@ OTHER_PROGS = \
bug429 \
bug457 \
bug480 \
bug480a \
bug51 \
bug85 \
builtin_false \

48
tests/valid/bug480a.m Normal file
View File

@@ -0,0 +1,48 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% This is a regression test for a special case of Mantis bug #480.
%
% Versions of the Mercury compiler between 2019 Jun 30 and 2019 Aug 7
% could not compile the correct code of get_g_arg below. The reason was that
% a fix for github issue 64 applied on Jun 30 prevented cse_detection.m
% from recognizing that the last two arms of the switch on FG are themselves
% a switch on the argument of g/1, because the inst of FG contains a unique
% component, namely the inst of the argument of f/1 (which is irrelevant
% to whether FG = g(...) can be pulled out of a disjunction).
%
%---------------------------------------------------------------------------%
:- module bug480a.
:- interface.
:- type sub_g
---> gs1(int)
; gs2(int).
:- type fg
---> f(f1 :: int)
; g(g1 :: sub_g).
:- inst u_fg for fg/0
---> f(unique)
; g(ground).
:- mode u_g_fg == u_fg >> ground.
:- pred get_g_arg(fg::u_g_fg, int::out) is det.
:- implementation.
:- import_module int.
get_g_arg(FG, N) :-
(
FG = f(_),
N = 0
;
FG = g(gs1(N))
;
FG = g(gs2(N))
).