[m-rev.] diff: case expression simplification for erlang backend
Peter Wang
wangp at students.csse.unimelb.edu.au
Wed Aug 15 11:49:41 AEST 2007
Estimated hours taken: 3
Branches: main
Simplify nested case expressions of a specific form generated by the Erlang
backend when calling semidet procedures, where the inner case expression
returns values which is switched on by the outer case expression. We can move
code from the arms of the outer case expression into the inner case expression.
e.g.
fib_1_f_0(N_3 ) ->
(case
(begin
V_4_4 = 2 ,
(case
N_3 =< V_4_4
of
true ->
{} ;
false ->
fail
end)
end)
of
{} ->
HeadVar__2_2 = 1 ,
HeadVar__2_2 ;
_ ->
V_8_8 = 1 ,
V_7_7 = N_3 - V_8_8 ,
V_5_5 = fib_1_f_0(V_7_7 ),
V_10_10 = 2 ,
V_9_9 = N_3 - V_10_10 ,
V_6_6 = fib_1_f_0(V_9_9 ),
HeadVar__2_2 = V_5_5 + V_6_6 ,
HeadVar__2_2
end).
===>
fib_1_f_0(N_3 ) ->
V_4_4 = 2 ,
(case
N_3 =< V_4_4
of
true ->
HeadVar__2_2 = 1 ,
HeadVar__2_2 ;
false ->
V_8_8 = 1 ,
V_7_7 = N_3 - V_8_8 ,
V_5_5 = fib_1_f_0(V_7_7 ),
V_10_10 = 2 ,
V_9_9 = N_3 - V_10_10 ,
V_6_6 = fib_1_f_0(V_9_9 ),
HeadVar__2_2 = V_5_5 + V_6_6 ,
HeadVar__2_2
end).
fib is ~20% faster.
compiler/erl_code_util.m:
Add a predicate to apply the simplication above.
compiler/erl_call_gen.m:
Apply the simplication to semidet calls.
compiler/erl_code_gen.m:
Apply the simplication to disjuncts.
Unrelated change: don't wrap disjuncts with case expressions when they
are unnecessary, e.g.
case foo() of
{} -> {};
fail -> fail
end
Index: compiler/erl_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_call_gen.m,v
retrieving revision 1.11
diff -u -r1.11 erl_call_gen.m
--- compiler/erl_call_gen.m 1 Aug 2007 05:47:06 -0000 1.11
+++ compiler/erl_call_gen.m 15 Aug 2007 00:28:03 -0000
@@ -235,9 +235,10 @@
% _ -> fail
% end
%
- Statement = elds_case_expr(CallExpr, [TrueCase, FalseCase]),
+ Statement0 = elds_case_expr(CallExpr, [TrueCase, FalseCase]),
TrueCase = elds_case(UnpackTerm, SuccessExpr),
- FalseCase = elds_case(elds_anon_var, elds_term(elds_fail))
+ FalseCase = elds_case(elds_anon_var, elds_term(elds_fail)),
+ maybe_simplify_nested_cases(Statement0, Statement)
).
:- pred make_nondet_call(elds_call_target::in, list(elds_expr)::in,
Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.23
diff -u -r1.23 erl_code_gen.m
--- compiler/erl_code_gen.m 7 Aug 2007 07:09:52 -0000 1.23
+++ compiler/erl_code_gen.m 15 Aug 2007 00:28:03 -0000
@@ -1078,9 +1078,10 @@
erl_bind_unbound_vars(!.Info, ThenVars, Else, InstMap0,
ElseStatement0, ElseStatement),
- IfStatement = elds_case_expr(CondStatement, [TrueCase, FalseCase]),
+ IfStatement0 = elds_case_expr(CondStatement, [TrueCase, FalseCase]),
TrueCase = elds_case(CondVarsTerm, ThenStatement),
FalseCase = elds_case(elds_anon_var, ElseStatement),
+ maybe_simplify_nested_cases(IfStatement0, IfStatement),
Statement = maybe_join_exprs1(MaybeMakeClosure, IfStatement)
;
CondCodeModel = model_non,
@@ -1430,10 +1431,6 @@
%
% where NonLocals are variables bound by Goal.
%
- % TODO This can lead to contorted code when <Goal> itself is a `case'
- % expression. In that case it would be better for <Goals> to appear in
- % the failure case of <Goal> directly.
- %
First = hlds_goal(_, FirstGoalInfo),
FirstCodeModel = goal_info_get_code_model(FirstGoalInfo),
@@ -1477,11 +1474,20 @@
;
erl_fix_success_expr(InstMap, First, MaybeSuccessExpr,
MaybeSuccessExprForFirst, !Info),
- Statement = elds_case_expr(FirstStatement,
- [SucceedCase, FailCase]),
- SucceedCase = elds_case(FirstVarsTerm,
- expr_or_void(MaybeSuccessExprForFirst)),
- FailCase = elds_case(elds_fail, RestStatement)
+ (
+ MaybeSuccessExprForFirst = yes(elds_term(FirstVarsTerm)),
+ RestStatement = elds_term(elds_fail)
+ ->
+ % No need to wrap in this case.
+ Statement = FirstStatement
+ ;
+ Statement0 = elds_case_expr(FirstStatement,
+ [SucceedCase, FailCase]),
+ SucceedCase = elds_case(FirstVarsTerm,
+ expr_or_void(MaybeSuccessExprForFirst)),
+ FailCase = elds_case(elds_fail, RestStatement),
+ maybe_simplify_nested_cases(Statement0, Statement)
+ )
)
;
FirstCodeModel = model_non,
Index: compiler/erl_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_util.m,v
retrieving revision 1.13
diff -u -r1.13 erl_code_util.m
--- compiler/erl_code_util.m 7 Aug 2007 07:09:52 -0000 1.13
+++ compiler/erl_code_util.m 15 Aug 2007 00:28:03 -0000
@@ -192,6 +192,13 @@
%
:- func erl_expr_size(elds_expr) = int.
+ % maybe_simplify_nested_cases(Expr0, Expr)
+ %
+ % Simplify Expr0 if it is a case expression of a specific form, otherwise
+ % return it unchanged. (See a later comment for the form.)
+ %
+:- pred maybe_simplify_nested_cases(elds_expr::in, elds_expr::out) is det.
+
%-----------------------------------------------------------------------------%
:- func erl_base_typeclass_info_method_offset = int.
@@ -415,6 +422,101 @@
%-----------------------------------------------------------------------------%
+ % Simplify nested case expressions of a specific form:
+ %
+ % case % OuterCaseExpr
+ % (begin
+ % Expr ..., % InnerPreamble
+ % case InnerCond of % InnerCaseExpr
+ % P1 -> M1;
+ % P2 -> M2;
+ % ...
+ % PN -> MN
+ % end
+ % end)
+ % of
+ % M1 -> R1; % OuterCases
+ % M2 -> R2;
+ % ...
+ % MN -> RN
+ % end
+ %
+ % As a special case, the last pattern MN in the outer case expression may
+ % be replaced by _ (the anonymous variable) and still match.
+ %
+ % ===>
+ %
+ % case InnerCond of
+ % P1 -> R1;
+ % P2 -> R2;
+ % ...
+ % PN -> RN
+ % end
+ %
+maybe_simplify_nested_cases(Expr0, Expr) :-
+ ( maybe_simplify_nested_cases_2(Expr0, Expr1) ->
+ Expr = Expr1
+ ;
+ Expr = Expr0
+ ).
+
+:- pred maybe_simplify_nested_cases_2(elds_expr::in, elds_expr::out)
+ is semidet.
+
+maybe_simplify_nested_cases_2(OuterCaseExpr, FinalExpr) :-
+ OuterCaseExpr = elds_case_expr(OuterCond, OuterCases),
+ (
+ OuterCond = elds_case_expr(InnerCond, InnerCases),
+ InnerPreamble = []
+ ;
+ OuterCond = elds_block(OuterCondExprs),
+ list.split_last(OuterCondExprs, InnerPreamble, InnerCaseExpr),
+ InnerCaseExpr = elds_case_expr(InnerCond, InnerCases)
+ ),
+ match_inner_outer_cases(OuterCases, InnerCases, NewCases),
+ FinalExpr = elds_block(InnerPreamble ++
+ [elds_case_expr(InnerCond, NewCases)]).
+
+:- pred match_inner_outer_cases(list(elds_case)::in, list(elds_case)::in,
+ list(elds_case)::out) is semidet.
+
+match_inner_outer_cases([], [], []).
+match_inner_outer_cases([OC | OCs], [IC | ICs], [NC | NCs]) :-
+ OC = elds_case(OuterPat, OuterExpr),
+ IC = elds_case(InnerPat, elds_term(InnerTerm)),
+ non_variable_term(InnerTerm),
+ (
+ % The value returned by the inner case expression should match the
+ % pattern in the outer case expression.
+ InnerTerm = OuterPat
+ ;
+ % If the last outer pattern is _ then allow it to match any inner
+ % expression.
+ OuterPat = elds_anon_var,
+ OCs = []
+ ),
+ NC = elds_case(InnerPat, OuterExpr),
+ match_inner_outer_cases(OCs, ICs, NCs).
+
+:- pred non_variable_term(elds_term::in) is semidet.
+
+non_variable_term(Term) :-
+ ( Term = elds_char(_)
+ ; Term = elds_int(_)
+ ; Term = elds_float(_)
+ ; Term = elds_string(_)
+ ; Term = elds_atom_raw(_)
+ ; Term = elds_atom(_)
+ ; Term = elds_tuple(SubTerms),
+ all [SubTerm] (
+ list.member(elds_term(SubTerm), SubTerms)
+ =>
+ non_variable_term(SubTerm)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
erl_var_or_dummy_replacement(ModuleInfo, VarTypes, DummyVarReplacement, Var) =
(if
map.search(VarTypes, Var, Type),
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list