QPQ-AG/sophia
10
0
Fork 0
Code Issues 41 Pull Requests 5 Actions Packages Projects Releases 16 Wiki Activity

Improve case-on-constructor optimisation

Browse Source
This commit is contained in:
Ulf Norell 2019-09-24 16:22:56 +02:00
parent 0a22c7a34a
commit bb1a45c557
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/aeso_ast_to_fcode.erl
View File

@ -760,7 +760,9 @@ split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) ->
I when is_integer(I) -> I when is_integer(I) ->
{Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars), {Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars),
SAlts = merge_alts(I, X, [ split_alt(I, A) || A <- Alts ]), SAlts = merge_alts(I, X, [ split_alt(I, A) || A <- Alts ]),
Cases = [ {'case', SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts)} MakeCase = fun({var, Z}, Split) -> {'case', {var, "_"}, rename_split([{Z, X}], Split)};
(SPat, Split) -> {'case', SPat, Split} end,
Cases = [ MakeCase(SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts))
|| {SPat, FAlts} <- SAlts ], || {SPat, FAlts} <- SAlts ],
{split, Type, X, Cases} {split, Type, X, Cases}
end. end.
@ -1298,14 +1300,11 @@ simplify(Env, {proj, {var, X}, I} = Expr) ->
E -> E E -> E
end; end;
simplify(Env, {switch, {split, _, X, Alts}} = Expr) -> simplify(Env, {switch, Split}) ->
case constructor_form(Env, {var, X}) of case simpl_switch(Env, Split) of
false -> Expr; nomatch -> {builtin, abort, [{lit, {string, <<"Incomplete patterns">>}}]};
E -> stuck -> {switch, Split};
case simpl_switch(Env, E, Alts) of Expr -> Expr
false -> Expr;
Expr1 -> Expr1
end
end; end;
simplify(_, E) -> simplify(_, E) ->
@ -1329,19 +1328,20 @@ simpl_proj(Env, I, Expr) ->
simpl_switch(_Env, {nosplit, E}) -> E; simpl_switch(_Env, {nosplit, E}) -> E;
simpl_switch(Env, {split, _, X, Alts}) -> simpl_switch(Env, {split, _, X, Alts}) ->
case constructor_form(Env, {var, X}) of case constructor_form(Env, {var, X}) of
false -> false; false -> stuck;
E -> simpl_switch(Env, E, Alts) E -> simpl_switch(Env, E, Alts)
end. end.
simpl_switch(_, _, []) -> false; simpl_switch(_, _, []) -> nomatch;
simpl_switch(Env, E, [{'case', Pat, Body} | Alts]) -> simpl_switch(Env, E, [{'case', Pat, Body} | Alts]) ->
case match_pat(Pat, E) of case match_pat(Pat, E) of
false -> simpl_switch(Env, E, Alts); false -> simpl_switch(Env, E, Alts);
Binds -> Binds ->
Env1 = maps:merge(Env, maps:from_list(Binds)), Env1 = maps:merge(Env, maps:from_list(Binds)),
case simpl_switch(Env1, Body) of case simpl_switch(Env1, Body) of
false -> false; nomatch -> simpl_switch(Env, E, Alts);
Body1 -> let_bind(Binds, Body1) stuck -> stuck;
Body1 -> let_bind(Binds, Body1)
end end
end. end.
@ -1992,7 +1992,7 @@ pp_ftype({tvar, X}) -> pp_text(X);
pp_ftype({bytes, N}) -> pp_call(pp_text("bytes"), [{lit, {int, N}}]); pp_ftype({bytes, N}) -> pp_call(pp_text("bytes"), [{lit, {int, N}}]);
pp_ftype({oracle, Q, R}) -> pp_call_t("oracle", [Q, R]); pp_ftype({oracle, Q, R}) -> pp_call_t("oracle", [Q, R]);
pp_ftype({tuple, Ts}) -> pp_ftype({tuple, Ts}) ->
pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts]))); pp_parens(pp_par(pp_punctuate(pp_text(" *"), [pp_ftype(T) || T <- Ts])));
pp_ftype({list, T}) -> pp_ftype({list, T}) ->
pp_call_t("list", [T]); pp_call_t("list", [T]);
pp_ftype({function, Args, Res}) -> pp_ftype({function, Args, Res}) ->