[m-rev.] for post-commit review: Match output arguments correctly for mutually recursive code
Paul Bone
paul at bone.id.au
Tue Apr 11 15:21:49 AEST 2017
For post-commit review by Zoltan
Last week Zoltan and I discussed testing this new optimistion on Prince's
code. I tried it and found the following problem.
--
Match output arguments correctly for mutually recursive code
Mutually-recursive tail calls might have different arguments than their
parents. They may have more or fewer arguments than the caller, and the
outputs may be in different positions. This change handles these correctly.
compiler/mark_tail_calls.m?
As above.
tests/valid/mutual_tailrec_outputs.m:
Add a test case that triggered a crash with mismatched argument list
lengths.
tests/valid/Mercury.options:
tests/valid/Mmakefile:
Add new test.
---
compiler/mark_tail_calls.m | 158 +++++++++++++++++++++++++----------
tests/valid/Mercury.options | 1 +
tests/valid/Mmakefile | 1 +
tests/valid/mutual_tailrec_outputs.m | 48 +++++++++++
4 files changed, 164 insertions(+), 44 deletions(-)
create mode 100644 tests/valid/mutual_tailrec_outputs.m
diff --git a/compiler/mark_tail_calls.m b/compiler/mark_tail_calls.m
index f473295..c12e145 100644
--- a/compiler/mark_tail_calls.m
+++ b/compiler/mark_tail_calls.m
@@ -458,7 +458,7 @@ do_mark_tail_rec_calls_in_proc(AddGoalFeature, WarnNonTailRecParams,
:- pred find_maybe_output_args(module_info::in,
list(mer_type)::in, list(mer_mode)::in, list(prog_var)::in,
- list(maybe(prog_var))::out) is det.
+ list(prog_var)::out) is det.
find_maybe_output_args(ModuleInfo, Types, Modes, Vars, Outputs) :-
( if
@@ -471,31 +471,41 @@ find_maybe_output_args(ModuleInfo, Types, Modes, Vars, Outputs) :-
:- pred find_maybe_output_args_2(module_info::in,
list(mer_type)::in, list(mer_mode)::in, list(prog_var)::in,
- list(maybe(prog_var))::out) is semidet.
+ list(prog_var)::out) is semidet.
find_maybe_output_args_2(_, [], [], [], []).
find_maybe_output_args_2(ModuleInfo, [Type | Types], [Mode | Modes],
- [Var | Vars], [OutputVar | OutputVars]) :-
+ [Var | Vars], OutputVars) :-
require_det (
- mode_to_top_functor_mode(ModuleInfo, Mode, Type, TopFunctorMode),
+ ( if is_output(ModuleInfo, Mode, Type) then
+ OutputVars = [Var | OutputVars0]
+ else
+ OutputVars = OutputVars0
+ )
+ ),
+ find_maybe_output_args_2(ModuleInfo, Types, Modes, Vars, OutputVars0).
+
+:- pred is_output(module_info::in, mer_mode::in, mer_type::in) is semidet.
+
+is_output(ModuleInfo, Mode, Type) :-
+ mode_to_top_functor_mode(ModuleInfo, Mode, Type, TopFunctorMode),
+ require_complete_switch [TopFunctorMode]
+ (
+ ( TopFunctorMode = top_in
+ ; TopFunctorMode = top_unused
+ ),
+ false
+ ;
+ TopFunctorMode = top_out,
+ IsDummy = check_dummy_type(ModuleInfo, Type),
+ require_complete_switch [IsDummy]
(
- ( TopFunctorMode = top_in
- ; TopFunctorMode = top_unused
- ),
- OutputVar = no
+ IsDummy = is_not_dummy_type
;
- TopFunctorMode = top_out,
- IsDummy = check_dummy_type(ModuleInfo, Type),
- (
- IsDummy = is_not_dummy_type,
- OutputVar = yes(Var)
- ;
- IsDummy = is_dummy_type,
- OutputVar = no
- )
+ IsDummy = is_dummy_type,
+ false
)
- ),
- find_maybe_output_args_2(ModuleInfo, Types, Modes, Vars, OutputVars).
+ ).
%---------------------------------------------------------------------------%
@@ -503,7 +513,7 @@ find_maybe_output_args_2(ModuleInfo, [Type | Types], [Mode | Modes],
% If it is, what are the output arguments?
%
:- type at_tail
- ---> at_tail(list(maybe(prog_var)))
+ ---> at_tail(list(prog_var))
; not_at_tail(later_rec_call).
:- type later_rec_call
@@ -736,7 +746,8 @@ mark_tail_rec_calls_in_goal(Goal0, Goal, AtTail0, AtTail, !Info) :-
!Info ^ mtc_any_rec_calls := found_any_rec_calls,
( if
AtTail0 = at_tail(Outputs),
- match_output_args(Outputs, Args)
+ match_output_args(!.Info, Outputs, Args, CalleePredId,
+ CalleeProcId, outputs_match)
then
AddFeature = !.Info ^ mtc_add_feature,
(
@@ -836,35 +847,94 @@ mark_tail_rec_calls_in_goal(Goal0, Goal, AtTail0, AtTail, !Info) :-
).
:- pred is_output_arg_rename(prog_var::in, prog_var::in,
- list(maybe(prog_var))::in, list(maybe(prog_var))::out) is semidet.
+ list(prog_var)::in, list(prog_var)::out) is semidet.
+
+is_output_arg_rename(ToVar, FromVar, [Var0 | Vars0], [Var | Vars]) :-
+ % The assignment assings _to_ ToVar, so we went to map _from_ ToVar back
+ % to FromVar.
+ ( if ToVar = Var0 then
+ Var = FromVar,
+ Vars = Vars0
+ else
+ % The original code didn't keep searching if the first output
+ % variable wasn't the one being renamed. That seems incorrect.
+ % -pbone.
+ Var = Var0,
+ is_output_arg_rename(ToVar, FromVar, Vars0, Vars)
+ ).
-is_output_arg_rename(ToVar, FromVar,
- [MaybeVar0 | MaybeVars0], [MaybeVar | MaybeVars]) :-
- (
- MaybeVar0 = yes(ToVar),
- MaybeVar = yes(FromVar),
- MaybeVars = MaybeVars0
- ;
- MaybeVar0 = no,
- MaybeVar = no,
- is_output_arg_rename(ToVar, FromVar, MaybeVars0, MaybeVars)
+:- type outputs_match
+ ---> outputs_match
+ ; outputs_dont_match.
+
+ % match output arguments to see if the call is in tail position WRT
+ % argument swaps.
+ %
+ % For self recursive code this can be very simple, it simply needs to
+ % check any of the caller's output arguments and see if the call site
+ % has the same variable in the same position, we know it's an output
+ % because the call and callee are the same.
+ %
+ % For mutualy recursive code this is more complex. We have to step
+ % through each list looking for pairs of outputs to mach, skipping any
+ % inputs (rather than pairing all arguments stepwise).
+ %
+ % We implement only the algorithm for mutually recursive code since that
+ % is also correct for self recursive code.
+ %
+:- pred match_output_args(mark_tail_rec_calls_info::in, list(prog_var)::in,
+ list(prog_var)::in, pred_id::in, proc_id::in, outputs_match::out) is det.
+
+match_output_args(Info, OutputVars, ArgVars, PredId, ProcId, Match) :-
+ module_info_pred_info(Info ^ mtc_module, PredId, PredInfo),
+ pred_info_get_arg_types(PredInfo, ArgTypes),
+ pred_info_proc_info(PredInfo, ProcId, ProcInfo),
+ proc_info_get_argmodes(ProcInfo, ArgModes),
+ ( if
+ match_output_args_2(Info, OutputVars, ArgVars, ArgTypes, ArgModes,
+ MatchPrime)
+ then
+ Match = MatchPrime
+ else
+ unexpected($file, $pred, "mismatched lists")
).
-:- pred match_output_args(list(maybe(prog_var))::in, list(prog_var)::in)
- is semidet.
+:- pred match_output_args_2(mark_tail_rec_calls_info::in, list(prog_var)::in,
+ list(prog_var)::in, list(mer_type)::in, list(mer_mode)::in,
+ outputs_match::out) is semidet.
-match_output_args([], []).
-match_output_args([], [_ | _]) :-
- unexpected($module, $pred, "length mismatch").
-match_output_args([_ | _], []) :-
- unexpected($module, $pred, "length mismatch").
-match_output_args([MaybeOutputVar | MaybeOutputVars], [ArgVar | ArgVars]) :-
+match_output_args_2(_, OutputVars, [], [], [], Match) :-
+ require_det
(
- MaybeOutputVar = no
+ OutputVars = [],
+ Match = outputs_match
;
- MaybeOutputVar = yes(ArgVar)
- ),
- match_output_args(MaybeOutputVars, ArgVars).
+ OutputVars = [_ | _],
+ Match = outputs_dont_match
+ ).
+match_output_args_2(Info, OutputVars0, [ArgVar | ArgVars],
+ [ArgType | ArgTypes], [ArgMode | ArgModes], Match) :-
+ (
+ OutputVars0 = [],
+ % Any remaning arguments (of the call site) don't matter, if they're
+ % outputs those outputs are simply ignored.
+ Match = outputs_match
+ ;
+ OutputVars0 = [OutputVar | OutputVars],
+ ( if is_output(Info ^ mtc_module, ArgMode, ArgType) then
+ ( if OutputVar = ArgVar then
+ match_output_args_2(Info, OutputVars, ArgVars, ArgTypes,
+ ArgModes, Match)
+ else
+ Match = outputs_dont_match
+ )
+ else
+ % Don't consume the current output if the current ArgVar is not
+ % an output.
+ match_output_args_2(Info, OutputVars0, ArgVars, ArgTypes,
+ ArgModes, Match)
+ )
+ ).
:- pred mark_tail_rec_calls_in_conj(list(hlds_goal)::in, list(hlds_goal)::out,
at_tail::in, at_tail::out,
diff --git a/tests/valid/Mercury.options b/tests/valid/Mercury.options
index 9b15670..dfa08bc 100644
--- a/tests/valid/Mercury.options
+++ b/tests/valid/Mercury.options
@@ -74,6 +74,7 @@ MCFLAGS-mc_implied_modes = --prop-mode-constraints
MCFLAGS-middle_rec_labels = --middle-rec
MCFLAGS-mostly_uniq_mode_inf = --infer-all
MCFLAGS-mpj6 = --infer-all
+MCFLAGS-mutual_tailrec_outputs = --inline-linear-tail-rec-sccs
MCFLAGS-neg_erroneous = -O3
MCFLAGS-negation_in_dupl_for_switch = --halt-at-warn
MCFLAGS-no_warn_format_imports = --warn-unused-imports --halt-at-warn
diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile
index 425f9d6..5bf3b26 100644
--- a/tests/valid/Mmakefile
+++ b/tests/valid/Mmakefile
@@ -181,6 +181,7 @@ OTHER_PROGS = \
mostly_uniq_neg \
multidet_prune1 \
multidet_test \
+ mutual_tailrec_outputs \
nasty_func_test \
neg_erroneous \
negation_in_dupl_for_switch \
diff --git a/tests/valid/mutual_tailrec_outputs.m b/tests/valid/mutual_tailrec_outputs.m
new file mode 100644
index 0000000..5f9c847
--- /dev/null
+++ b/tests/valid/mutual_tailrec_outputs.m
@@ -0,0 +1,48 @@
+
+:- module mutual_tailrec_outputs.
+
+:- interface.
+
+:- import_module list.
+
+:- type a ---> a.
+
+% This case triggered a problem with mark_tail_calls when it checked for
+% mutual recursion, which was introduced with --inline-linear-tail-rec-sccs.
+% The compiler crashed when the number of parameters in the callee and
+% caller didn't match.
+
+:- pred my_condense(list(list(list(a))), list(a)).
+:- mode my_condense(in, out) is det.
+
+:- implementation.
+
+my_condense([], []).
+my_condense([GList|Gs0], Gs) :-
+ ( if GList = [GList0], Gs0 = [] then
+ % fast path, avoid rebuilding list
+ Gs = GList0
+ else
+ my_condense0(GList, Gs0, Gs)
+ ).
+
+:- pred my_condense0(list(list(a)), list(list(list(a))), list(a)).
+:- mode my_condense0(in, in, out) is det.
+
+my_condense0([], Gs1, Gs) :-
+ my_condense(Gs1, Gs).
+
+my_condense0([G0|Gs0], Gs1, Gs) :-
+ my_condense1(G0, Gs0, Gs1, Gs).
+
+:- pred my_condense1(list(a), list(list(a)), list(list(list(a))), list(a)).
+:- mode my_condense1(in, in, in, out) is det.
+
+my_condense1([], Gs1, Gs2, Gs) :-
+ my_condense0(Gs1, Gs2, Gs).
+
+my_condense1([G|Gs0], Gs1, Gs2, Gs) :-
+ my_condense1(Gs0, Gs1, Gs2, Gs3),
+ Gs = [G|Gs3].
+
+
--
2.7.4
More information about the reviews
mailing list