diff options
Diffstat (limited to 'lib/compiler/src/v3_kernel.erl')
| -rw-r--r-- | lib/compiler/src/v3_kernel.erl | 476 |
1 files changed, 2 insertions, 474 deletions
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 49fb66126f..3f7f7f95d6 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -85,7 +85,7 @@ map/2,mapfoldl/3,member/2, keyfind/3,keyreplace/4, last/1,partition/2,reverse/1, - splitwith/2,sort/1]). + splitwith/2]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). @@ -111,7 +111,6 @@ copy_anno(Kdst, Ksrc) -> -record(iclause, {anno=[],isub,osub,pats,guard,body}). -record(ireceive_accept, {anno=[],arg}). -record(ireceive_next, {anno=[],arg}). --record(ignored, {anno=[]}). -type warning() :: term(). % XXX: REFINE @@ -206,478 +205,9 @@ guard(G0, Sub, St0) -> {G1,St1} = wrap_guard(G0, St0), {Ge0,Pre,St2} = expr(G1, Sub, St1), {Ge1,St3} = gexpr_test(Ge0, St2), - {Ge,St} = guard_opt(Ge1, St3), + {Ge,St} = {Ge1,St3}, {pre_seq(Pre, Ge),St}. -%% guard_opt(Kexpr, State) -> {Kexpr,State}. -%% Optimize the Kexpr for the guard. Instead of evaluating a boolean -%% expression comparing it to 'true' in a final #k_test{}, -%% replace BIF calls with #k_test{} in the expression. -%% -%% As an example, take the guard: -%% -%% when is_integer(V0), is_atom(V1) -> -%% -%% The unoptimized Kexpr translated to pseudo BEAM assembly -%% code would look like: -%% -%% bif is_integer V0 => Bool0 -%% bif is_atom V1 => Bool1 -%% bif and Bool0 Bool1 => Bool -%% test Bool =:= true else goto Fail -%% ... -%% Fail: -%% ... -%% -%% The optimized code would look like: -%% -%% test is_integer V0 else goto Fail -%% test is_atom V1 else goto Fail -%% ... -%% Fail: -%% ... -%% -%% An 'or' operation is only slightly more complicated: -%% -%% test is_integer V0 else goto NotFailedYet -%% goto Success -%% -%% NotFailedYet: -%% test is_atom V1 else goto Fail -%% -%% Success: -%% ... -%% Fail: -%% ... - -guard_opt(G, St0) -> - {Root,Forest0,St1} = make_forest(G, St0), - {Exprs,Forest,St} = rewrite_bool(Root, Forest0, false, St1), - E = forest_pre_seq(Exprs, Forest), - {G#k_try{arg=E},St}. - -%% rewrite_bool(Kexpr, Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite Kexpr to use #k_test{} operations instead of comparison -%% and type test BIFs. -%% -%% If Kexpr is a #k_test{} operation, the call will always -%% succeed. Otherwise, a 'not_possible' exception will be -%% thrown if Kexpr cannot be rewritten. - -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_var{}=V,#k_atom{val=true}]}=Test, Forest0, Inv, St0) -> - try rewrite_bool_var(V, Forest0, Inv, St0) of - {_,_,_}=Res -> - Res - catch - throw:not_possible -> - {[Test],Forest0,St0} - end; -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_var{}=V,#k_atom{val=false}]}=Test, Forest0, Inv, St0) -> - try rewrite_bool_var(V, Forest0, not Inv, St0) of - {_,_,_}=Res -> - Res - catch - throw:not_possible -> - {[Test],Forest0,St0} - end; -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_atom{val=V1},#k_atom{val=V2}]}, Forest0, false, St0) -> - case V1 =:= V2 of - true -> - {[make_test(is_boolean, [#k_atom{val=true}])],Forest0,St0}; - false -> - {[make_failing_test()],Forest0,St0} - end; -rewrite_bool(#k_test{}=Test, Forest, false, St) -> - {[Test],Forest,St}; -rewrite_bool(#k_try{vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false},ret=[]}=Prot, - Forest0, Inv, St0) -> - {Root,Forest1,St1} = make_forest(Prot, Forest0, St0), - {Exprs,Forest2,St} = rewrite_bool(Root, Forest1, Inv, St1), - InnerForest = maps:without(maps:keys(Forest0), Forest2), - Forest = maps:without(maps:keys(InnerForest), Forest2), - E = forest_pre_seq(Exprs, InnerForest), - {[Prot#k_try{arg=E}],Forest,St}; -rewrite_bool(#k_match{body=Body,ret=[]}, Forest, Inv, St) -> - rewrite_match(Body, Forest, Inv, St); -rewrite_bool(Other, Forest, Inv, St) -> - case extract_bif(Other) of - {Name,Args} -> - rewrite_bif(Name, Args, Forest, Inv, St); - error -> - throw(not_possible) - end. - -%% rewrite_bool_var(Var, Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite the boolean expression whose key in Forest is -%% given by Var. Throw a 'not_possible' expression if something -%% prevents the rewriting. - -rewrite_bool_var(Arg, Forest0, Inv, St) -> - {Expr,Forest} = forest_take_expr(Arg, Forest0), - rewrite_bool(Expr, Forest, Inv, St). - -%% rewrite_bool_args([Kexpr], Forest, Inv, St) -> {[[Kexpr]],Forest,St}. -%% Rewrite each Kexpr in the list. The input Kexpr should be variables -%% or boolean values. Throw a 'not_possible' expression if something -%% prevents the rewriting. -%% -%% This function is suitable for handling the arguments for both -%% 'and' and 'or'. - -rewrite_bool_args([#k_atom{val=B}=A|Vs], Forest0, false=Inv, St0) when is_boolean(B) -> - {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), - Bif = make_bif('=:=', [A,#k_atom{val=true}]), - {Exprs,Forest,St} = rewrite_bool(Bif, Forest1, Inv, St1), - {[Exprs|Tail],Forest,St}; -rewrite_bool_args([#k_var{}=Var|Vs], Forest0, false=Inv, St0) -> - {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), - {Exprs,Forest,St} = - case is_bool_expr(Var, Forest0) of - true -> - rewrite_bool_var(Var, Forest1, Inv, St1); - false -> - Bif = make_bif('=:=', [Var,#k_atom{val=true}]), - rewrite_bool(Bif, Forest1, Inv, St1) - end, - {[Exprs|Tail],Forest,St}; -rewrite_bool_args([_|_], _Forest, _Inv, _St) -> - throw(not_possible); -rewrite_bool_args([], Forest, _Inv, St) -> - {[],Forest,St}. - -%% rewrite_bif(Name, [Kexpr], Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite a BIF. Throw a 'not_possible' expression if something -%% prevents the rewriting. - -rewrite_bif('or', Args, Forest, true, St) -> - rewrite_not_args('and', Args, Forest, St); -rewrite_bif('and', Args, Forest, true, St) -> - rewrite_not_args('or', Args, Forest, St); -rewrite_bif('and', [#k_atom{val=Val},Arg], Forest0, Inv, St0) -> - false = Inv, %Assertion. - case Val of - true -> - %% The result only depends on Arg. - rewrite_bool_var(Arg, Forest0, Inv, St0); - _ -> - %% Will fail. There is no need to evalute the expression - %% represented by Arg. Take it out from the forest and - %% discard the expression. - Failing = make_failing_test(), - try rewrite_bool_var(Arg, Forest0, Inv, St0) of - {_,Forest,St} -> - {[Failing],Forest,St} - catch - throw:not_possible -> - try forest_take_expr(Arg, Forest0) of - {_,Forest} -> - {[Failing],Forest,St0} - catch - throw:not_possible -> - %% Arg is probably a variable bound in an - %% outer scope. - {[Failing],Forest0,St0} - end - end - end; -rewrite_bif('and', [Arg,#k_atom{}=Atom], Forest, Inv, St) -> - false = Inv, %Assertion. - rewrite_bif('and', [Atom,Arg], Forest, Inv, St); -rewrite_bif('and', Args, Forest0, Inv, St0) -> - false = Inv, %Assertion. - {[Es1,Es2],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), - {Es1 ++ Es2,Forest,St}; -rewrite_bif('or', Args, Forest0, Inv, St0) -> - false = Inv, %Assertion. - {[First,Then],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), - Alt = make_alt(First, Then), - {[Alt],Forest,St}; -rewrite_bif('xor', [_,_], _Forest, _Inv, _St) -> - %% Rewriting 'xor' is not practical. Fortunately, 'xor' is - %% almost never used in practice. - throw(not_possible); -rewrite_bif('not', [Arg], Forest0, Inv, St) -> - {Expr,Forest} = forest_take_expr(Arg, Forest0), - rewrite_bool(Expr, Forest, not Inv, St); -rewrite_bif(Op, Args, Forest, Inv, St) -> - case is_test(Op, Args) of - true -> - rewrite_bool(make_test(Op, Args, Inv), Forest, false, St); - false -> - throw(not_possible) - end. - -rewrite_not_args(Op, [A0,B0], Forest0, St0) -> - {A,Forest1,St1} = rewrite_not_args_1(A0, Forest0, St0), - {B,Forest2,St2} = rewrite_not_args_1(B0, Forest1, St1), - rewrite_bif(Op, [A,B], Forest2, false, St2). - -rewrite_not_args_1(Arg, Forest, St) -> - Not = make_bif('not', [Arg]), - forest_add_expr(Not, Forest, St). - -%% rewrite_match(Kvar, TypeClause, Forest, Inv, St) -> -%% {[Kexpr],Forest,St}. -%% Try to rewrite a #k_match{} originating from an 'andalso' or an 'orelse'. - -rewrite_match(#k_alt{first=First,then=Then}, Forest, Inv, St) -> - case {First,Then} of - {#k_select{var=#k_var{name=V}=Var,types=[TypeClause]},#k_var{name=V}} -> - rewrite_match_1(Var, TypeClause, Forest, Inv, St); - {_,_} -> - throw(not_possible) - end. - -rewrite_match_1(Var, #k_type_clause{values=Cs0}, Forest0, Inv, St0) -> - Cs = sort([{Val,B} || #k_val_clause{val=#k_atom{val=Val},body=B} <- Cs0]), - case Cs of - [{false,False},{true,True}] -> - rewrite_match_2(Var, False, True, Forest0, Inv, St0); - _ -> - throw(not_possible) - end. - -rewrite_match_2(Var, False, #k_atom{val=true}, Forest0, Inv, St0) -> - %% Originates from an 'orelse'. - case False of - #k_atom{val=NotBool} when not is_boolean(NotBool) -> - rewrite_bool(Var, Forest0, Inv, St0); - _ -> - {CodeVar,Forest1,St1} = add_protected_expr(False, Forest0, St0), - rewrite_bif('or', [Var,CodeVar], Forest1, Inv, St1) - end; -rewrite_match_2(Var, #k_atom{val=false}, True, Forest0, Inv, St0) -> - %% Originates from an 'andalso'. - {CodeVar,Forest1,St1} = add_protected_expr(True, Forest0, St0), - rewrite_bif('and', [Var,CodeVar], Forest1, Inv, St1); -rewrite_match_2(_V, _, _, _Forest, _Inv, _St) -> - throw(not_possible). - -%% is_bool_expr(#k_var{}, Forest) -> true|false. -%% Return true if the variable refers to a boolean expression -%% that does not need an explicit '=:= true' test. - -is_bool_expr(V, Forest) -> - case forest_peek_expr(V, Forest) of - error -> - %% Defined outside of the guard. We can't know. - false; - Expr -> - case extract_bif(Expr) of - {Name,Args} -> - is_test(Name, Args) orelse - erl_internal:bool_op(Name, length(Args)); - error -> - %% Not a BIF. Should be possible to rewrite - %% to a boolean. Definitely does not need - %% a '=:= true' test. - true - end - end. - -make_bif(Op, Args) -> - #k_bif{op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Op}, - arity=length(Args)}, - args=Args}. - -extract_bif(#k_bif{op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Name}}, - args=Args}) -> - {Name,Args}; -extract_bif(_) -> - error. - -%% make_alt(First, Then) -> KMatch. -%% Make a #k_alt{} within a #k_match{} to implement -%% 'or' or 'orelse'. - -make_alt(First0, Then0) -> - First1 = pre_seq(droplast(First0), last(First0)), - Then1 = pre_seq(droplast(Then0), last(Then0)), - First2 = make_protected(First1), - Then2 = make_protected(Then1), - Body = #ignored{}, - First3 = #k_guard_clause{guard=First2,body=Body}, - Then3 = #k_guard_clause{guard=Then2,body=Body}, - First = #k_guard{clauses=[First3]}, - Then = #k_guard{clauses=[Then3]}, - Alt = #k_alt{first=First,then=Then}, - #k_match{vars=[],body=Alt}. - -add_protected_expr(#k_atom{}=Atom, Forest, St) -> - {Atom,Forest,St}; -add_protected_expr(#k_var{}=Var, Forest, St) -> - {Var,Forest,St}; -add_protected_expr(E0, Forest, St) -> - E = make_protected(E0), - forest_add_expr(E, Forest, St). - -make_protected(#k_try{}=Try) -> - Try; -make_protected(B) -> - #k_try{arg=B,vars=[#k_var{name=''}],body=#k_var{name=''}, - handler=#k_atom{val=false}}. - -make_failing_test() -> - make_test(is_boolean, [#k_atom{val=fail}]). - -make_test(Op, Args) -> - make_test(Op, Args, false). - -make_test(Op, Args, Inv) -> - Remote = #k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Op}, - arity=length(Args)}, - #k_test{op=Remote,args=Args,inverted=Inv}. - -is_test(Op, Args) -> - A = length(Args), - erl_internal:new_type_test(Op, A) orelse erl_internal:comp_op(Op, A). - -%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. -%% Build a forest out of Kexpr. RootKexpr is the final expression -%% nested inside Kexpr. - -make_forest(G, St) -> - make_forest_1(G, #{}, 0, St). - -%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. -%% Add to Forest from Kexpr. RootKexpr is the final expression -%% nested inside Kexpr. - -make_forest(G, Forest0, St) -> - N = forest_next_index(Forest0), - make_forest_1(G, Forest0, N, St). - -make_forest_1(#k_try{arg=B}, Forest, I, St) -> - make_forest_1(B, Forest, I, St); -make_forest_1(#iset{vars=[]}=Iset0, Forest, I, St0) -> - {UnrefVar,St} = new_var(St0), - Iset = Iset0#iset{vars=[UnrefVar]}, - make_forest_1(Iset, Forest, I, St); -make_forest_1(#iset{vars=[#k_var{name=V}],arg=Arg,body=B}, Forest0, I, St) -> - Forest = Forest0#{V => {I,Arg}, {untaken,V} => true}, - make_forest_1(B, Forest, I+1, St); -make_forest_1(Innermost, Forest, _I, St) -> - {Innermost,Forest,St}. - -%% forest_take_expr(Kexpr, Forest) -> {Expr,Forest}. -%% If Kexpr is a variable, take out the expression corresponding -%% to variable in Forest. Expressions that have been taken out -%% of the forest will not be included the Kexpr returned -%% by forest_pre_seq/2. -%% -%% Throw a 'not_possible' exception if Kexpr is not a variable or -%% if the name of the variable is not a key in Forest. - -forest_take_expr(#k_var{name=V}, Forest0) -> - %% v3_core currently always generates guard expressions that can - %% be represented as a tree. Other code generators (such as LFE) - %% could generate guard expressions that can only be represented - %% as a DAG (i.e. some nodes are referenced more than once). To - %% handle DAGs, we must never remove a node from the forest, but - %% just remove the {untaken,V} marker. That will effectively convert - %% the DAG to a tree by duplicating the shared nodes and their - %% descendants. - - case maps:find(V, Forest0) of - {ok,{_,Expr}} -> - Forest = maps:remove({untaken,V}, Forest0), - {Expr,Forest}; - error -> - throw(not_possible) - end; -forest_take_expr(_, _) -> - throw(not_possible). - -%% forest_peek_expr(Kvar, Forest) -> Kexpr | error. -%% Return the expression corresponding to Kvar in Forest or -%% return 'error' if there is a corresponding expression. - -forest_peek_expr(#k_var{name=V}, Forest0) -> - case maps:find(V, Forest0) of - {ok,{_,Expr}} -> Expr; - error -> error - end. - -%% forest_add_expr(Kexpr, Forest, St) -> {Kvar,Forest,St}. -%% Add a new expression to Forest. - -forest_add_expr(Expr, Forest0, St0) -> - {#k_var{name=V}=Var,St} = new_var(St0), - N = forest_next_index(Forest0), - Forest = Forest0#{V => {N,Expr}}, - {Var,Forest,St}. - -forest_next_index(Forest) -> - 1 + lists:max([N || {N,_} <- maps:values(Forest), - is_integer(N)] ++ [0]). - -%% forest_pre_seq([Kexpr], Forest) -> Kexpr. -%% Package the list of Kexprs into a nested Kexpr, prepending all -%% expressions in Forest that have not been taken out using -%% forest_take_expr/2. - -forest_pre_seq(Exprs, Forest) -> - Es0 = [#k_var{name=V} || {untaken,V} <- maps:keys(Forest)], - Es = Es0 ++ Exprs, - Vs = extract_all_vars(Es, Forest, []), - Pre0 = sort([{maps:get(V, Forest),V} || V <- Vs]), - Pre = [#iset{vars=[#k_var{name=V}],arg=A} || - {{_,A},V} <- Pre0], - pre_seq(Pre++droplast(Exprs), last(Exprs)). - -extract_all_vars(Es, Forest, Acc0) -> - case extract_var_list(Es) of - [] -> - Acc0; - [_|_]=Vs0 -> - Vs = [V || V <- Vs0, maps:is_key(V, Forest)], - NewVs = ordsets:subtract(Vs, Acc0), - NewEs = [begin - {_,E} = maps:get(V, Forest), - E - end || V <- NewVs], - Acc = union(NewVs, Acc0), - extract_all_vars(NewEs, Forest, Acc) - end. - -extract_vars(#iset{arg=A,body=B}) -> - union(extract_vars(A), extract_vars(B)); -extract_vars(#k_bif{args=Args}) -> - ordsets:from_list(lit_list_vars(Args)); -extract_vars(#k_call{}) -> - []; -extract_vars(#k_test{args=Args}) -> - ordsets:from_list(lit_list_vars(Args)); -extract_vars(#k_match{body=Body}) -> - extract_vars(Body); -extract_vars(#k_alt{first=First,then=Then}) -> - union(extract_vars(First), extract_vars(Then)); -extract_vars(#k_guard{clauses=Cs}) -> - extract_var_list(Cs); -extract_vars(#k_guard_clause{guard=G}) -> - extract_vars(G); -extract_vars(#k_select{var=Var,types=Types}) -> - union(ordsets:from_list(lit_vars(Var)), - extract_var_list(Types)); -extract_vars(#k_type_clause{values=Values}) -> - extract_var_list(Values); -extract_vars(#k_val_clause{body=Body}) -> - extract_vars(Body); -extract_vars(#k_try{arg=Arg}) -> - extract_vars(Arg); -extract_vars(Lit) -> - ordsets:from_list(lit_vars(Lit)). - -extract_var_list(L) -> - union([extract_vars(E) || E <- L]). - %% Wrap the entire guard in a try/catch if needed. wrap_guard(#c_try{}=Try, St) -> {Try,St}; @@ -2356,8 +1886,6 @@ ubody(E, return, St0) -> {Ea,Pa,St1} = force_atomic(E, St0), ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1) end; -ubody(#ignored{}, {break,_} = Break, St) -> - ubody(#ivalues{args=[]}, Break, St); ubody(E, {break,[_]} = Break, St0) -> %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]), %% Exiting expressions need no trailing break. |