%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
%% Purpose : Transform normal Erlang to Core Erlang
%% At this stage all preprocessing has been done. All that is left are
%% "pure" Erlang functions.
%%
%% Core transformation is done in three stages:
%%
%% 1. Flatten expressions into an internal core form without doing
%% matching.
%%
%% 2. Step "forwards" over the icore code annotating each "top-level"
%% thing with variable usage. Detect bound variables in matching
%% and replace with explicit guard test. Annotate "internal-core"
%% expressions with variables they use and create. Convert matches
%% to cases when not pure assignments.
%%
%% 3. Step "backwards" over icore code using variable usage
%% annotations to change implicit exported variables to explicit
%% returns.
%%
%% To ensure the evaluation order we ensure that all arguments are
%% safe. A "safe" is basically a core_lib simple with VERY restricted
%% binaries.
%%
%% We have to be very careful with matches as these create variables.
%% While we try not to flatten things more than necessary we must make
%% sure that all matches are at the top level. For this we use the
%% type "novars" which are non-match expressions. Cases and receives
%% can also create problems due to exports variables so they are not
%% "novars" either. I.e. a novars will not export variables.
%%
%% Annotations in the #iset, #iletrec, and all other internal records
%% is kept in a record, #a, not in a list as in proper core. This is
%% easier and faster and creates no problems as we have complete control
%% over all annotations.
%%
%% On output, the annotation for most Core Erlang terms will contain
%% the source line number. A few terms will be marked with the atom
%% atom 'compiler_generated', to indicate that the compiler has generated
%% them and that no warning should be generated if they are optimized
%% away.
%%
%%
%% In this translation:
%%
%% call ops are safes
%% call arguments are safes
%% match arguments are novars
%% case arguments are novars
%% receive timeouts are novars
%% let/set arguments are expressions
%% fun is not a safe
-module(v3_core).
-export([module/2,format_error/1]).
-import(lists, [reverse/1,reverse/2,map/2,member/2,foldl/3,foldr/3,mapfoldl/3,
splitwith/2,keyfind/3,sort/1,foreach/2]).
-import(ordsets, [add_element/2,del_element/2,is_element/2,
union/1,union/2,intersection/2,subtract/2]).
-import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1]).
-include("core_parse.hrl").
%% Internal core expressions and help functions.
%% N.B. annotations fields in place as normal Core expressions.
-record(a, {us=[],ns=[],anno=[]}). %Internal annotation
-record(iapply, {anno=#a{},op,args}).
-record(ibinary, {anno=#a{},segments}). %Not used in patterns.
-record(icall, {anno=#a{},module,name,args}).
-record(icase, {anno=#a{},args,clauses,fc}).
-record(icatch, {anno=#a{},body}).
-record(iclause, {anno=#a{},pats,pguard=[],guard,body}).
-record(ifun, {anno=#a{},id,vars,clauses,fc,name=unnamed}).
-record(iletrec, {anno=#a{},defs,body}).
-record(imatch, {anno=#a{},pat,guard=[],arg,fc}).
-record(iprimop, {anno=#a{},name,args}).
-record(iprotect, {anno=#a{},body}).
-record(ireceive1, {anno=#a{},clauses}).
-record(ireceive2, {anno=#a{},clauses,timeout,action}).
-record(iset, {anno=#a{},var,arg}).
-record(itry, {anno=#a{},args,vars,body,evars,handler}).
-type iapply() :: #iapply{}.
-type ibinary() :: #ibinary{}.
-type icall() :: #icall{}.
-type icase() :: #icase{}.
-type icatch() :: #icatch{}.
-type iclause() :: #iclause{}.
-type ifun() :: #ifun{}.
-type iletrec() :: #iletrec{}.
-type imatch() :: #imatch{}.
-type iprimop() :: #iprimop{}.
-type iprotect() :: #iprotect{}.
-type ireceive1() :: #ireceive1{}.
-type ireceive2() :: #ireceive2{}.
-type iset() :: #iset{}.
-type itry() :: #itry{}.
-type i() :: iapply() | ibinary() | icall() | icase() | icatch()
| iclause() | ifun() | iletrec() | imatch() | iprimop()
| iprotect() | ireceive1() | ireceive2() | iset() | itry().
-type warning() :: {file:filename(), [{integer(), module(), term()}]}.
-record(core, {vcount=0 :: non_neg_integer(), %Variable counter
fcount=0 :: non_neg_integer(), %Function counter
in_guard=false :: boolean(), %In guard or not.
wanted=true :: boolean(), %Result wanted or not.
opts :: [compile:option()], %Options.
ws=[] :: [warning()], %Warnings.
file=[{file,""}]}). %File
%% XXX: The following type declarations do not belong in this module
-type fa() :: {atom(), arity()}.
-type attribute() :: atom().
-type form() :: {function, integer(), atom(), arity(), _}
| {attribute, integer(), attribute(), _}.
-spec module({module(), [fa()], [form()]}, [compile:option()]) ->
{'ok',cerl:c_module(),[warning()]}.
module({Mod,Exp,Forms}, Opts) ->
Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp),
{Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) ->
form(F, Acc, Opts)
end, {[],[],[],[]}, Forms),
Kfs = reverse(Kfs0),
As = reverse(As0),
{ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}.
form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) ->
{F,Ws} = function(F0, Ws0, File, Opts),
{[F|Fs],As,Ws,File};
form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) ->
{Fs,As,Ws,File};
form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
{Fs,[attribute(F)|As],Ws,File}.
attribute({attribute,Line,Name,Val}) ->
{#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}.
function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) ->
%%ok = io:fwrite("~p - ", [{Name,Arity}]),
St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]},
{B0,St1} = body(Cs0, Name, Arity, St0),
%%ok = io:fwrite("1", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B0]),
{B1,St2} = ubody(B0, St1),
%%ok = io:fwrite("2", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B1]),
{B2,#core{ws=Ws}} = cbody(B1, St2),
%%ok = io:fwrite("3~n", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B2]),
{{#c_var{name={Name,Arity}},B2},Ws}.
body(Cs0, Name, Arity, St0) ->
Anno = lineno_anno(element(2, hd(Cs0)), St0),
{Args,St1} = new_vars(Anno, Arity, St0),
{Cs1,St2} = clauses(Cs0, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
Fc = function_clause(Ps, Anno, {Name,Arity}),
{#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}.
%% clause(Clause, State) -> {Cclause,State} | noclause.
%% clauses([Clause], State) -> {[Cclause],State}.
%% Convert clauses. Trap bad pattern aliases and remove clause from
%% clause list.
clauses([C0|Cs0], St0) ->
case clause(C0, St0) of
{noclause,St} -> clauses(Cs0, St);
{C,St1} ->
{Cs,St2} = clauses(Cs0, St1),
{[C|Cs],St2}
end;
clauses([], St) -> {[],St}.
clause({clause,Lc,H0,G0,B0}, St0) ->
try head(H0, St0) of
H1 ->
{G1,St1} = guard(G0, St0),
{B1,St2} = exprs(B0, St1),
Anno = lineno_anno(Lc, St2),
{#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St2}
catch
throw:nomatch ->
St = add_warning(Lc, nomatch, St0),
{noclause,St} %Bad pattern
end.
clause_arity({clause,_,H0,_,_}) -> length(H0).
%% head([P], State) -> [P].
head(Ps, St) -> pattern_list(Ps, St).
%% guard([Expr], State) -> {[Cexpr],State}.
%% Build an explict and/or tree of guard alternatives, then traverse
%% top-level and/or tree and "protect" inner tests.
guard([], St) -> {[],St};
guard(Gs0, St0) ->
Gs1 = foldr(fun (Gt0, Rhs) ->
Gt1 = guard_tests(Gt0),
L = element(2, Gt1),
{op,L,'or',Gt1,Rhs}
end, guard_tests(last(Gs0)), first(Gs0)),
{Gs,St} = gexpr_top(Gs1, St0#core{in_guard=true}),
{Gs,St#core{in_guard=false}}.
guard_tests(Gs) ->
L = element(2, hd(Gs)),
{protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), first(Gs))}.
%% gexpr_top(Expr, State) -> {Cexpr,State}.
%% Generate an internal core expression of a guard test. Explicitly
%% handle outer boolean expressions and "protect" inner tests in a
%% reasonably smart way.
gexpr_top(E0, St0) ->
{E1,Eps0,Bools,St1} = gexpr(E0, [], St0),
{E,Eps,St} = force_booleans(Bools, E1, Eps0, St1),
{Eps++[E],St}.
%% gexpr(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}.
%% Generate an internal core expression of a guard test.
gexpr({protect,Line,Arg}, Bools0, St0) ->
case gexpr(Arg, [], St0) of
{E0,[],Bools,St1} ->
{E,Eps,St} = force_booleans(Bools, E0, [], St1),
{E,Eps,Bools0,St};
{E0,Eps0,Bools,St1} ->
{E,Eps,St} = force_booleans(Bools, E0, Eps0, St1),
Anno = lineno_anno(Line, St),
{#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St}
end;
gexpr({op,L,'andalso',E1,E2}, Bools, St0) ->
{#c_var{name=V0},St} = new_var(L, St0),
V = {var,L,V0},
False = {atom,L,false},
E = make_bool_switch_guard(L, E1, V, E2, False),
gexpr(E, Bools, St);
gexpr({op,L,'orelse',E1,E2}, Bools, St0) ->
{#c_var{name=V0},St} = new_var(L, St0),
V = {var,L,V0},
True = {atom,L,true},
E = make_bool_switch_guard(L, E1, V, True, E2),
gexpr(E, Bools, St);
gexpr({op,Line,Op,L,R}=Call, Bools0, St0) ->
case erl_internal:bool_op(Op, 2) of
true ->
{Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0),
{Ll,Llps,St2} = force_safe(Le, St1),
{Re,Rps,Bools,St3} = gexpr(R, Bools1, St2),
{Rl,Rlps,St4} = force_safe(Re, St3),
Anno = lineno_anno(Line, St4),
{#icall{anno=#a{anno=Anno}, %Must have an #a{}
module=#c_literal{anno=Anno,val=erlang},
name=#c_literal{anno=Anno,val=Op},
args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4};
false ->
gexpr_test(Call, Bools0, St0)
end;
gexpr({op,Line,Op,A}=Call, Bools0, St0) ->
case Op of
'not' ->
{Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0),
case Ae0 of
#icall{module=#c_literal{val=erlang},
name=#c_literal{val='=:='},
args=[E,#c_literal{val=true}]}=EqCall ->
%%
%% Doing the following transformation
%% not(Expr =:= true) ==> Expr =:= false
%% will help eliminating redundant is_boolean/1 tests.
%%
Ae = EqCall#icall{args=[E,#c_literal{val=false}]},
{Al,Alps,St2} = force_safe(Ae, St1),
{Al,Aps ++ Alps,Bools,St2};
Ae ->
{Al,Alps,St2} = force_safe(Ae, St1),
Anno = lineno_anno(Line, St2),
{#icall{anno=#a{anno=Anno}, %Must have an #a{}
module=#c_literal{anno=Anno,val=erlang},
name=#c_literal{anno=Anno,val=Op},
args=[Al]},Aps ++ Alps,Bools,St2}
end;
_ ->
gexpr_test(Call, Bools0, St0)
end;
gexpr(E0, Bools, St0) ->
gexpr_test(E0, Bools, St0).
%% gexpr_test(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}.
%% Generate a guard test. At this stage we must be sure that we have
%% a proper boolean value here so wrap things with an true test if we
%% don't know, i.e. if it is not a comparison or a type test.
gexpr_test({atom,L,true}, Bools, St0) ->
{#c_literal{anno=lineno_anno(L, St0),val=true},[],Bools,St0};
gexpr_test({atom,L,false}, Bools, St0) ->
{#c_literal{anno=lineno_anno(L, St0),val=false},[],Bools,St0};
gexpr_test(E0, Bools0, St0) ->
{E1,Eps0,St1} = expr(E0, St0),
%% Generate "top-level" test and argument calls.
case E1 of
#icall{anno=Anno,module=#c_literal{val=erlang},name=#c_literal{val=N},args=As} ->
Ar = length(As),
case erl_internal:type_test(N, Ar) orelse
erl_internal:comp_op(N, Ar) of
true -> {E1,Eps0,Bools0,St1};
false ->
Lanno = Anno#a.anno,
{New,St2} = new_var(Lanno, St1),
Bools = [New|Bools0],
{#icall{anno=Anno, %Must have an #a{}
module=#c_literal{anno=Lanno,val=erlang},
name=#c_literal{anno=Lanno,val='=:='},
args=[New,#c_literal{anno=Lanno,val=true}]},
Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2}
end;
_ ->
Anno = get_ianno(E1),
Lanno = get_lineno_anno(E1),
case is_simple(E1) of
true ->
Bools = [E1|Bools0],
{#icall{anno=Anno, %Must have an #a{}
module=#c_literal{anno=Lanno,val=erlang},
name=#c_literal{anno=Lanno,val='=:='},
args=[E1,#c_literal{anno=Lanno,val=true}]},Eps0,Bools,St1};
false ->
{New,St2} = new_var(Lanno, St1),
Bools = [New|Bools0],
{#icall{anno=Anno, %Must have an #a{}
module=#c_literal{anno=Lanno,val=erlang},
name=#c_literal{anno=Lanno,val='=:='},
args=[New,#c_literal{anno=Lanno,val=true}]},
Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2}
end
end.
force_booleans(Vs0, E, Eps, St) ->
Vs1 = [set_anno(V, []) || V <- Vs0],
Vs = unforce(E, Eps, Vs1),
force_booleans_1(Vs, E, Eps, St).
force_booleans_1([], E, Eps, St) ->
{E,Eps,St};
force_booleans_1([V|Vs], E0, Eps0, St0) ->
{E1,Eps1,St1} = force_safe(E0, St0),
Lanno = element(2, V),
Anno = #a{anno=Lanno},
Call = #icall{anno=Anno,module=#c_literal{anno=Lanno,val=erlang},
name=#c_literal{anno=Lanno,val=is_boolean},
args=[V]},
{New,St} = new_var(Lanno, St1),
Iset = #iset{anno=Anno,var=New,arg=Call},
Eps = Eps0 ++ Eps1 ++ [Iset],
E = #icall{anno=Anno,
module=#c_literal{anno=Lanno,val=erlang},name=#c_literal{anno=Lanno,val='and'},
args=[E1,New]},
force_booleans_1(Vs, E, Eps, St).
%% unforce(Expr, PreExprList, BoolExprList) -> BoolExprList'.
%% Filter BoolExprList. BoolExprList is a list of simple expressions
%% (variables or literals) of which we are not sure whether they are booleans.
%%
%% The basic idea for filtering is the following transformation
%%
%% (E =:= Bool) and is_boolean(E) ==> E =:= Bool
%%
%% where E is an arbitrary expression and Bool is 'true' or 'false'.
%%
%% The transformation is still valid if there are other expressions joined
%% by 'and' operations:
%%
%% E1 and (E2 =:= true) and E3 and is_boolean(E) ==> E1 and (E2 =:= true) and E3
%%
%% but expressions such as
%%
%% not (E =:= true) and is_boolean(E)
%%
%% cannot be transformed in this way (such expressions are the reason for
%% adding the is_boolean/1 test in the first place).
%%
unforce(_, _, []) ->
[];
unforce(E, Eps, Vs) ->
Tree = unforce_tree(Eps++[E], gb_trees:empty()),
unforce(Tree, Vs).
unforce_tree([#iset{var=#c_var{name=V},arg=Arg0}|Es], D0) ->
Arg = unforce_tree_subst(Arg0, D0),
D = gb_trees:insert(V, Arg, D0),
unforce_tree(Es, D);
unforce_tree([#icall{}=Call], D) ->
unforce_tree_subst(Call, D);
unforce_tree([Top], _) -> Top.
unforce_tree_subst(#icall{module=#c_literal{val=erlang},
name=#c_literal{val='=:='},
args=[_Expr,#c_literal{val=Bool}]}=Call, _)
when is_boolean(Bool) ->
%% We have erlang:'=:='(Expr, Bool). We must not expand this call any more
%% or we will not recognize is_boolean(Expr) later.
Call;
unforce_tree_subst(#icall{args=Args0}=Call, D) ->
Args = map(fun(#c_var{name=V}=Var) ->
case gb_trees:lookup(V, D) of
{value,Val} -> Val;
none -> Var
end;
(Expr) -> Expr
end, Args0),
Call#icall{args=Args};
unforce_tree_subst(Expr, _) -> Expr.
unforce(#icall{module=#c_literal{val=erlang},
name=#c_literal{val=Name},
args=Args}, Vs0) ->
case {Name,Args} of
{'and',[Arg1,Arg2]} ->
Vs = unforce(Arg1, Vs0),
unforce(Arg2, Vs);
{'=:=',[E,#c_literal{val=Bool}]} when is_boolean(Bool) ->
Vs0 -- [set_anno(E, [])];
{_,_} ->
%% Give up.
Vs0
end;
unforce(_, Vs) -> Vs.
%% exprs([Expr], State) -> {[Cexpr],State}.
%% Flatten top-level exprs.
exprs([E0|Es0], St0) ->
{E1,Eps,St1} = expr(E0, St0),
{Es1,St2} = exprs(Es0, St1),
{Eps ++ [E1] ++ Es1,St2};
exprs([], St) -> {[],St}.
%% expr(Expr, State) -> {Cexpr,[PreExp],State}.
%% Generate an internal core expression.
expr({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St};
expr({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St};
expr({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St};
expr({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St};
expr({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St};
expr({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St};
expr({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St};
expr({cons,L,H0,T0}, St0) ->
{H1,Hps,St1} = safe(H0, St0),
{T1,Tps,St2} = safe(T0, St1),
A = lineno_anno(L, St2),
{ann_c_cons(A, H1, T1),Hps ++ Tps,St2};
expr({lc,L,E,Qs}, St) ->
lc_tq(L, E, Qs, #c_literal{anno=lineno_anno(L, St),val=[]}, St);
expr({bc,L,E,Qs}, St) ->
bc_tq(L, E, Qs, {nil,L}, St);
expr({tuple,L,Es0}, St0) ->
{Es1,Eps,St1} = safe_list(Es0, St0),
A = lineno_anno(L, St1),
{ann_c_tuple(A, Es1),Eps,St1};
expr({map,L,Es0}, St0) ->
% erl_lint should make sure only #{ K => V } are allowed
% in map construction.
{Es1,Eps,St1} = map_pair_list(Es0, St0),
A = lineno_anno(L, St1),
{#c_map{anno=A,es=Es1},Eps,St1};
expr({map,L,M0,Es0}, St0) ->
{M1,Mps,St1} = safe(M0, St0),
{Es1,Eps,St2} = map_pair_list(Es0, St1),
A = lineno_anno(L, St2),
{#c_map{anno=A,var=M1,es=Es1},Mps++Eps,St2};
expr({bin,L,Es0}, St0) ->
try expr_bin(Es0, lineno_anno(L, St0), St0) of
{_,_,_}=Res -> Res
catch
throw:bad_binary ->
St = add_warning(L, bad_binary, St0),
LineAnno = lineno_anno(L, St),
As = [#c_literal{anno=LineAnno,val=badarg}],
{#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
module=#c_literal{anno=LineAnno,val=erlang},
name=#c_literal{anno=LineAnno,val=error},
args=As},[],St}
end;
expr({block,_,Es0}, St0) ->
%% Inline the block directly.
{Es1,St1} = exprs(first(Es0), St0),
{E1,Eps,St2} = expr(last(Es0), St1),
{E1,Es1 ++ Eps,St2};
expr({'if',L,Cs0}, St0) ->
{Cs1,St1} = clauses(Cs0, St0),
Lanno = lineno_anno(L, St1),
Fc = fail_clause([], Lanno, #c_literal{val=if_clause}),
{#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1};
expr({'case',L,E0,Cs0}, St0) ->
{E1,Eps,St1} = novars(E0, St0),
{Cs1,St2} = clauses(Cs0, St1),
{Fpat,St3} = new_var(St2),
Lanno = lineno_anno(L, St2),
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])),
{#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3};
expr({'receive',L,Cs0}, St0) ->
{Cs1,St1} = clauses(Cs0, St0),
{#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1}, [], St1};
expr({'receive',L,Cs0,Te0,Tes0}, St0) ->
{Te1,Teps,St1} = novars(Te0, St0),
{Tes1,St2} = exprs(Tes0, St1),
{Cs1,St3} = clauses(Cs0, St2),
{#ireceive2{anno=#a{anno=lineno_anno(L, St3)},
clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3};
expr({'try',L,Es0,[],Ecs,[]}, St0) ->
%% 'try ... catch ... end'
{Es1,St1} = exprs(Es0, St0),
{V,St2} = new_var(St1), %This name should be arbitrary
{Evs,Hs,St3} = try_exception(Ecs, St2),
Lanno = lineno_anno(L, St3),
{#itry{anno=#a{anno=Lanno},args=Es1,vars=[V],body=[V],
evars=Evs,handler=Hs},
[],St3};
expr({'try',L,Es0,Cs0,Ecs,[]}, St0) ->
%% 'try ... of ... catch ... end'
{Es1,St1} = exprs(Es0, St0),
{V,St2} = new_var(St1), %This name should be arbitrary
{Cs1,St3} = clauses(Cs0, St2),
{Fpat,St4} = new_var(St3),
Lanno = lineno_anno(L, St4),
Fc = fail_clause([Fpat], Lanno,
c_tuple([#c_literal{val=try_clause},Fpat])),
{Evs,Hs,St5} = try_exception(Ecs, St4),
{#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1,
vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}],
evars=Evs,handler=Hs},
[],St5};
expr({'try',L,Es0,[],[],As0}, St0) ->
%% 'try ... after ... end'
{Es1,St1} = exprs(Es0, St0),
{As1,St2} = exprs(As0, St1),
{Name,St3} = new_fun_name("after", St2),
{V,St4} = new_var(St3), % (must not exist in As1)
LA = lineno_anno(L, St4),
Lanno = #a{anno=LA},
Fc = function_clause([], LA, {Name,0}),
Fun = #ifun{anno=Lanno,id=[],vars=[],
clauses=[#iclause{anno=Lanno,pats=[],
guard=[#c_literal{val=true}],
body=As1}],
fc=Fc},
App = #iapply{anno=#a{anno=[compiler_generated|LA]},
op=#c_var{anno=LA,name={Name,0}},args=[]},
{Evs,Hs,St5} = try_after([App], St4),
Try = #itry{anno=Lanno,args=Es1,vars=[V],body=[App,V],evars=Evs,handler=Hs},
Letrec = #iletrec{anno=Lanno,defs=[{{Name,0},Fun}],
body=[Try]},
{Letrec,[],St5};
expr({'try',L,Es,Cs,Ecs,As}, St0) ->
%% 'try ... [of ...] [catch ...] after ... end'
expr({'try',L,[{'try',L,Es,Cs,Ecs,[]}],[],[],As}, St0);
expr({'catch',L,E0}, St0) ->
{E1,Eps,St1} = expr(E0, St0),
Lanno = lineno_anno(L, St1),
{#icatch{anno=#a{anno=Lanno},body=Eps ++ [E1]},[],St1};
expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) ->
Lanno = lineno_anno(L, St),
{#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St};
expr({'fun',L,{function,M,F,A}}, St0) ->
{As,Aps,St1} = safe_list([M,F,A], St0),
Lanno = lineno_anno(L, St1),
{#icall{anno=#a{anno=Lanno},
module=#c_literal{val=erlang},
name=#c_literal{val=make_fun},
args=As},Aps,St1};
expr({'fun',L,{clauses,Cs},Id}, St) ->
fun_tq(Id, Cs, L, St, unnamed);
expr({named_fun,L,'_',Cs,Id}, St) ->
fun_tq(Id, Cs, L, St, unnamed);
expr({named_fun,L,Name,Cs,{Index,Uniq,_Fname}}, St) ->
fun_tq({Index,Uniq,Name}, Cs, L, St, {named, Name});
expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) ->
{[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0),
Lanno = lineno_anno(L, St1),
Anno = case Wanted of
false -> [result_not_wanted|Lanno];
true -> Lanno
end,
{#icall{anno=#a{anno=Anno},module=M1,name=F1,args=As1},Aps,St1};
expr({call,Lc,{atom,Lf,F},As0}, St0) ->
{As1,Aps,St1} = safe_list(As0, St0),
Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}},
{#iapply{anno=#a{anno=lineno_anno(Lc, St1)},op=Op,args=As1},Aps,St1};
expr({call,L,FunExp,As0}, St0) ->
{Fun,Fps,St1} = safe(FunExp, St0),
{As1,Aps,St2} = safe_list(As0, St1),
Lanno = lineno_anno(L, St2),
{#iapply{anno=#a{anno=Lanno},op=Fun,args=As1},Fps ++ Aps,St2};
expr({match,L,P0,E0}, St0) ->
%% First fold matches together to create aliases.
{P1,E1} = fold_match(E0, P0),
St1 = case P1 of
{var,_,'_'} -> St0#core{wanted=false};
_ -> St0
end,
{E2,Eps,St2} = novars(E1, St1),
St3 = St2#core{wanted=St0#core.wanted},
P2 = try
pattern(P1, St3)
catch
throw:Thrown ->
Thrown
end,
{Fpat,St4} = new_var(St3),
Lanno = lineno_anno(L, St4),
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])),
case P2 of
nomatch ->
St = add_warning(L, nomatch, St4),
{#icase{anno=#a{anno=Lanno},
args=[E2],clauses=[],fc=Fc},Eps,St};
Other when not is_atom(Other) ->
{#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4}
end;
expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) ->
%% Optimise '++' here because of the list comprehension algorithm.
%%
%% To avoid achieving quadratic complexity if there is a chain of
%% list comprehensions without generators combined with '++', force
%% evaluation of More now. Evaluating More here could also reduce the
%% number variables in the environment for letrec.
{Mc,Mps,St1} = safe(More, St0),
{Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St1),
{Y,Mps++Yps,St};
expr({op,L,'andalso',E1,E2}, St0) ->
{#c_var{name=V0},St} = new_var(L, St0),
V = {var,L,V0},
False = {atom,L,false},
E = make_bool_switch(L, E1, V, E2, False, St0),
expr(E, St);
expr({op,L,'orelse',E1,E2}, St0) ->
{#c_var{name=V0},St} = new_var(L, St0),
V = {var,L,V0},
True = {atom,L,true},
E = make_bool_switch(L, E1, V, True, E2, St0),
expr(E, St);
expr({op,L,Op,A0}, St0) ->
{A1,Aps,St1} = safe(A0, St0),
LineAnno = lineno_anno(L, St1),
{#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
module=#c_literal{anno=LineAnno,val=erlang},
name=#c_literal{anno=LineAnno,val=Op},args=[A1]},Aps,St1};
expr({op,L,Op,L0,R0}, St0) ->
{As,Aps,St1} = safe_list([L0,R0], St0),
LineAnno = lineno_anno(L, St1),
{#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
module=#c_literal{anno=LineAnno,val=erlang},
name=#c_literal{anno=LineAnno,val=Op},args=As},Aps,St1}.
make_bool_switch(L, E, V, T, F, #core{in_guard=true}) ->
make_bool_switch_guard(L, E, V, T, F);
make_bool_switch(L, E, V, T, F, #core{}) ->
make_bool_switch_body(L, E, V, T, F).
make_bool_switch_body(L, E, V, T, F) ->
NegL = neg_line(abs_line(L)),
Error = {tuple,NegL,[{atom,NegL,badarg},V]},
{'case',NegL,E,
[{clause,NegL,[{atom,NegL,true}],[],[T]},
{clause,NegL,[{atom,NegL,false}],[],[F]},
{clause,NegL,[V],[],
[{call,NegL,{remote,NegL,{atom,NegL,erlang},{atom,NegL,error}},
[Error]}]}]}.
make_bool_switch_guard(_, E, _, {atom,_,true}, {atom,_,false}) -> E;
make_bool_switch_guard(L, E, V, T, F) ->
NegL = neg_line(abs_line(L)),
{'case',NegL,E,
[{clause,NegL,[{atom,NegL,true}],[],[T]},
{clause,NegL,[{atom,NegL,false}],[],[F]},
{clause,NegL,[V],[],[V]}
]}.
map_pair_list(Es, St) ->
foldr(fun
({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) ->
{K,Ep0,St1} = safe(K0, St0),
{V,Ep1,St2} = safe(V0, St1),
A = lineno_anno(L, St2),
Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V},
{[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2};
({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) ->
{K,Ep0,St1} = safe(K0, St0),
{V,Ep1,St2} = safe(V0, St1),
A = lineno_anno(L, St2),
Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V},
{[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}
end, {[],[],St}, Es).
%% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}.
try_exception(Ecs0, St0) ->
%% Note that Tag is not needed for rethrow - it is already in Info.
{Evs,St1} = new_vars(3, St0), % Tag, Value, Info
{Ecs1,St2} = clauses(Ecs0, St1),
[_,Value,Info] = Evs,
Ec = #iclause{anno=#a{anno=[compiler_generated]},
pats=[c_tuple(Evs)],guard=[#c_literal{val=true}],
body=[#iprimop{anno=#a{}, %Must have an #a{}
name=#c_literal{val=raise},
args=[Info,Value]}]},
Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}],
{Evs,Hs,St2}.
try_after(As, St0) ->
%% See above.
{Evs,St1} = new_vars(3, St0), % Tag, Value, Info
[_,Value,Info] = Evs,
B = As ++ [#iprimop{anno=#a{}, %Must have an #a{}
name=#c_literal{val=raise},
args=[Info,Value]}],
Ec = #iclause{anno=#a{anno=[compiler_generated]},
pats=[c_tuple(Evs)],guard=[#c_literal{val=true}],
body=B},
Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=[],fc=Ec}],
{Evs,Hs,St1}.
%% expr_bin([ArgExpr], St) -> {[Arg],[PreExpr],St}.
%% Flatten the arguments of a bin. Do this straight left to right!
%% Note that ibinary needs to have its annotation wrapped in a #a{}
%% record whereas c_literal should not have a wrapped annotation
expr_bin(Es0, Anno, St0) ->
case constant_bin(Es0) of
error ->
{Es,Eps,St} = expr_bin_1(Es0, St0),
{#ibinary{anno=#a{anno=Anno},segments=Es},Eps,St};
Bin ->
{#c_literal{anno=Anno,val=Bin},[],St0}
end.
%% constant_bin([{bin_element,_,_,_,_}]) -> binary() | error
%% If the binary construction is truly constant (no variables,
%% no native fields), and does not contain fields whose expansion
%% become huge (such as <<0:100000000>>), evaluate and return the binary;
%% otherwise return 'error'.
constant_bin(Es) ->
try
constant_bin_1(Es)
catch
error -> error
end.
constant_bin_1(Es) ->
verify_suitable_fields(Es),
EmptyBindings = erl_eval:new_bindings(),
EvalFun = fun({integer,_,I}, B) -> {value,I,B};
({char,_,C}, B) -> {value,C,B};
({float,_,F}, B) -> {value,F,B};
({atom,_,undefined}, B) -> {value,undefined,B}
end,
case catch eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of
{value,Bin,EmptyBindings} ->
Bin;
_ ->
error
end.
%% verify_suitable_fields([{bin_element,_,Sz,Opts}=E|Es]) ->
verify_suitable_fields([{bin_element,_,Val,SzTerm,Opts}|Es]) ->
case member(big, Opts) orelse member(little, Opts) of
true -> ok;
false -> throw(error) %Native endian.
end,
{unit,Unit} = keyfind(unit, 1, Opts),
case {SzTerm,Val} of
{{atom,_,undefined},{char,_,_}} ->
%% UTF-8/16/32.
ok;
{{atom,_,undefined},{integer,_,_}} ->
%% UTF-8/16/32.
ok;
{{integer,_,Sz},_} when Sz*Unit =< 256 ->
%% Don't be cheap - always accept fields up to this size.
ok;
{{integer,_,Sz0},{integer,_,Int}} ->
%% Estimate the number of bits needed to to hold the integer
%% literal. Check whether the field size is reasonable in
%% proportion to the number of bits needed.
Sz = Sz0*Unit,
case count_bits(Int) of
BitsNeeded when 2*BitsNeeded >= Sz ->
ok;
_ ->
%% More than about half of the field size will be
%% filled out with zeroes - not acceptable.
throw(error)
end;
{_,_} ->
%% Reject anything else. There are either variables,
%% or a float with a huge size or an embedded binary.
throw(error)
end,
verify_suitable_fields(Es);
verify_suitable_fields([]) -> ok.
%% Count the number of bits approximately needed to store Int.
%% (We don't need an exact result for this purpose.)
count_bits(Int) ->
count_bits_1(abs_line(Int), 64).
count_bits_1(0, Bits) -> Bits;
count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64).
expr_bin_1(Es, St) ->
foldr(fun (E, {Ces,Esp,St0}) ->
{Ce,Ep,St1} = bitstr(E, St0),
{[Ce|Ces],Ep ++ Esp,St1}
end, {[],[],St}, Es).
bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) ->
{E1,Eps,St1} = safe(E0, St0),
{Size1,Eps2,St2} = safe(Size0, St1),
case {Type,E1} of
{_,#c_var{}} -> ok;
{integer,#c_literal{val=I}} when is_integer(I) -> ok;
{utf8,#c_literal{val=I}} when is_integer(I) -> ok;
{utf16,#c_literal{val=I}} when is_integer(I) -> ok;
{utf32,#c_literal{val=I}} when is_integer(I) -> ok;
{float,#c_literal{val=V}} when is_number(V) -> ok;
{binary,#c_literal{val=V}} when is_bitstring(V) -> ok;
{_,_} ->
throw(bad_binary)
end,
case Size1 of
#c_var{} -> ok;
#c_literal{val=Sz} when is_integer(Sz), Sz >= 0 -> ok;
#c_literal{val=undefined} -> ok;
#c_literal{val=all} -> ok;
_ -> throw(bad_binary)
end,
{#c_bitstr{val=E1,size=Size1,
unit=#c_literal{val=Unit},
type=#c_literal{val=Type},
flags=#c_literal{val=Flags}},
Eps ++ Eps2,St2}.
%% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}.
fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
Arity = clause_arity(hd(Cs0)),
{Cs1,St1} = clauses(Cs0, St0),
{Args,St2} = new_vars(Arity, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
Anno = lineno_anno(L, St3),
Fc = function_clause(Ps, Anno, {Name,Arity}),
Fun = #ifun{anno=#a{anno=Anno},
id=[{id,Id}], %We KNOW!
vars=Args,clauses=Cs1,fc=Fc,name=NameInfo},
{Fun,[],St3}.
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
%% This gets a bit messy as we must transform all directly here. We
%% recognise guard tests and try to fold them together and join to a
%% preceding generators, this should give us better and more compact
%% code.
lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("lc", St0),
{Head,St2} = new_var(St1),
{Tname,St3} = new_var_name(St2),
LA = lineno_anno(Line, St3),
LAnno = #a{anno=LA},
Tail = #c_var{anno=LA,name=Tname},
{Arg,St4} = new_var(St3),
{Nc,[],St5} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St4),
{Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
{Lc,Lps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
{Pc,St8} = list_gen_pattern(P, Line, St7),
{Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
Fc = function_clause([Arg], LA, {Name,1}),
%% Avoid constructing a default clause if the list comprehension
%% only has a variable as generator and there are no guard
%% tests. In other words, if the comprehension is equivalent to
%% lists:map/2.
Cs0 = case {Guardc, Pc} of
{[], #c_var{}} ->
[#iclause{anno=LAnno,
pats=[#c_literal{anno=LA,val=[]}],guard=[],
body=[Mc]}];
_ ->
[#iclause{anno=#a{anno=[compiler_generated|LA]},
pats=[ann_c_cons(LA, Head, Tail)],
guard=[],
body=[Nc]},
#iclause{anno=LAnno,
pats=[#c_literal{anno=LA,val=[]}],guard=[],
body=[Mc]}]
end,
Cs = case Pc of
nomatch -> Cs0;
_ ->
[#iclause{anno=LAnno,
pats=[ann_c_cons(LA, Pc, Tail)],
guard=Guardc,
body=Lps ++ [Lc]}|Cs0]
end,
Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,1}},
args=[Gc]}]},
[],St9};
lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("blc", St0),
LA = lineno_anno(Line, St1),
LAnno = #a{anno=LA},
HeadBinPattern = pattern(P, St1),
#c_binary{segments=Ps0} = HeadBinPattern,
{Ps,Tail,St2} = append_tail_segment(Ps0, St1),
{EPs,St3} = emasculate_segments(Ps, St2),
Pattern = HeadBinPattern#c_binary{segments=Ps},
EPattern = HeadBinPattern#c_binary{segments=EPs},
{Arg,St4} = new_var(St3),
{Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
Tname = Tail#c_var.name,
{Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5),
{Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
{Gc,Gps,St10} = safe(G, St7), %Will be a function argument!
Fc = function_clause([Arg], LA, {Name,1}),
{TailSegList,_,St} = append_tail_segment([], St10),
Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]},
pats=[Pattern],
guard=Guardc,
body=Bps ++ [Bc]},
#iclause{anno=#a{anno=[compiler_generated|LA]},
pats=[EPattern],
guard=[],
body=[#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,1}},
args=[Tail]}]},
#iclause{anno=LAnno,
pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[],
body=[Mc]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,1}},
args=[Gc]}]},
[],St};
lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(element(2, Fil0), St0),
LAnno = #a{anno=LA},
case is_guard_test(Fil0) of
true ->
{Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Lc,Lps,St1} = lc_tq(Line, E, Qs1, Mc, St0),
{Gs,St2} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat!
{#icase{anno=LAnno,
args=[],
clauses=[#iclause{anno=LAnno,pats=[],
guard=Gs,body=Lps ++ [Lc]}],
fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
pats=[],guard=[],body=[Mc]}},
[],St2};
false ->
{Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0),
{Fpat,St2} = new_var(St1),
Fc = fail_clause([Fpat], LA,
c_tuple([#c_literal{val=case_clause},Fpat])),
%% Do a novars little optimisation here.
{Filc,Fps,St3} = novars(Fil0, St2),
{#icase{anno=LAnno,
args=[Filc],
clauses=[#iclause{anno=LAnno,
pats=[#c_literal{anno=LA,val=true}],
guard=[],
body=Lps ++ [Lc]},
#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
pats=[#c_literal{anno=LA,val=false}],
guard=[],
body=[Mc]}],
fc=Fc},
Fps,St3}
end;
lc_tq(Line, E0, [], Mc0, St0) ->
{H1,Hps,St1} = safe(E0, St0),
{T1,Tps,St} = force_safe(Mc0, St1),
Anno = lineno_anno(Line, St),
E = ann_c_cons(Anno, H1, T1),
{set_anno(E, [compiler_generated|Anno]),Hps ++ Tps,St}.
%% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}.
%% This TQ from Gustafsson ERLANG'05.
%% This gets a bit messy as we must transform all directly here. We
%% recognise guard tests and try to fold them together and join to a
%% preceding generators, this should give us better and more compact
%% code.
%% More could be transformed before calling bc_tq.
bc_tq(Line, Exp, Qualifiers, _, St0) ->
{BinVar,St1} = new_var(St0),
{Sz,SzPre,St2} = bc_initial_size(Exp, Qualifiers, St1),
{E,BcPre,St} = bc_tq1(Line, Exp, Qualifiers, BinVar, St2),
Pre = SzPre ++
[#iset{var=BinVar,
arg=#iprimop{name=#c_literal{val=bs_init_writable},
args=[Sz]}}] ++ BcPre,
{E,Pre,St}.
bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("lbc", St0),
LA = lineno_anno(Line, St1),
{[Head,Tail,AccVar],St2} = new_vars(LA, 3, St1),
LAnno = #a{anno=LA},
{Arg,St3} = new_var(St2),
NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
{var,Lg,AccVar#c_var.name}]},
{Guardc,St4} = lc_guard_tests(Gs, St3), %These are always flat!
{Lc,Lps,St5} = bc_tq1(Line, E, Qs1, AccVar, St4),
{Nc,Nps,St6} = expr(NewMore, St5),
{Pc,St7} = list_gen_pattern(P, Line, St6),
{Gc,Gps,St8} = safe(G, St7), %Will be a function argument!
Fc = function_clause([Arg,AccVar], LA, {Name,2}),
Cs0 = case {Guardc, Pc} of
{[], #c_var{}} ->
[#iclause{anno=LAnno,
pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[],
body=[AccVar]}];
_ ->
[#iclause{anno=#a{anno=[compiler_generated|LA]},
pats=[ann_c_cons(LA, Head, Tail),AccVar],
guard=[],
body=Nps ++ [Nc]},
#iclause{anno=LAnno,
pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[],
body=[AccVar]}]
end,
Cs = case Pc of
nomatch -> Cs0;
_ ->
Body = Lps ++ Nps ++ [#iset{var=AccVar,arg=Lc},Nc],
[#iclause{anno=LAnno,
pats=[ann_c_cons(LA,Pc,Tail),AccVar],
guard=Guardc,
body=Body}|Cs0]
end,
Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno,defs=[{{Name,2},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,2}},
args=[Gc,AccExpr]}]},
[],St8};
bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("lbc", St0),
LA = lineno_anno(Line, St1),
{AccVar,St2} = new_var(LA, St1),
LAnno = #a{anno=LA},
HeadBinPattern = pattern(P, St2),
#c_binary{segments=Ps0} = HeadBinPattern,
{Ps,Tail,St3} = append_tail_segment(Ps0, St2),
{EPs,St4} = emasculate_segments(Ps, St3),
Pattern = HeadBinPattern#c_binary{segments=Ps},
EPattern = HeadBinPattern#c_binary{segments=EPs},
{Arg,St5} = new_var(St4),
NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
{var,Lg,AccVar#c_var.name}]},
{Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
{Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6),
{Nc,Nps,St8} = expr(NewMore, St7),
{Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
Fc = function_clause([Arg,AccVar], LA, {Name,2}),
Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc],
{TailSegList,_,St} = append_tail_segment([], St9),
Cs = [#iclause{anno=LAnno,
pats=[Pattern,AccVar],
guard=Guardc,
body=Body},
#iclause{anno=#a{anno=[compiler_generated|LA]},
pats=[EPattern,AccVar],
guard=[],
body=Nps ++ [Nc]},
#iclause{anno=LAnno,
pats=[#c_binary{anno=LA,segments=TailSegList},AccVar],
guard=[],
body=[AccVar]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno,defs=[{{Name,2},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,2}},
args=[Gc,AccExpr]}]},
[],St};
bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(element(2, Fil0), St0),
LAnno = #a{anno=LA},
case is_guard_test(Fil0) of
true ->
{Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Bc,Bps,St1} = bc_tq1(Line, E, Qs1, AccVar, St0),
{Gs,St} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat!
{#icase{anno=LAnno,
args=[],
clauses=[#iclause{anno=LAnno,
pats=[],
guard=Gs,body=Bps ++ [Bc]}],
fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
pats=[],guard=[],body=[AccVar]}},
[],St};
false ->
{Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0),
{Fpat,St2} = new_var(St1),
Fc = fail_clause([Fpat], LA,
c_tuple([#c_literal{val=case_clause},Fpat])),
%% Do a novars little optimisation here.
{Filc,Fps,St} = novars(Fil0, St2),
{#icase{anno=LAnno,
args=[Filc],
clauses=[#iclause{anno=LAnno,
pats=[#c_literal{anno=LA,val=true}],
guard=[],
body=Bps ++ [Bc]},
#iclause{anno=LAnno#a{anno=[compiler_generated|LA]},
pats=[#c_literal{anno=LA,val=false}],
guard=[],
body=[AccVar]}],
fc=Fc},
Fps,St}
end;
bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) ->
{E,Pre,St} = expr({bin,Bl,[{bin_element,Bl,
{var,Bl,AccVar#c_var.name},
{atom,Bl,all},
[binary,{unit,1}]}|Elements]}, St0),
#a{anno=A} = Anno0 = get_anno(E),
Anno = Anno0#a{anno=[compiler_generated,single_use|A]},
%%Anno = Anno0#a{anno=[compiler_generated|A]},
{set_anno(E, Anno),Pre,St}.
append_tail_segment(Segs, St0) ->
{Var,St} = new_var(St0),
Tail = #c_bitstr{val=Var,size=#c_literal{val=all},
unit=#c_literal{val=1},
type=#c_literal{val=binary},
flags=#c_literal{val=[unsigned,big]}},
{Segs++[Tail],Var,St}.
emasculate_segments(Segs, St) ->
emasculate_segments(Segs, St, []).
emasculate_segments([#c_bitstr{val=#c_var{}}=B|Rest], St, Acc) ->
emasculate_segments(Rest, St, [B|Acc]);
emasculate_segments([B|Rest], St0, Acc) ->
{Var,St1} = new_var(St0),
emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]);
emasculate_segments([], St, Acc) ->
{lists:reverse(Acc),St}.
lc_guard_tests([], St) -> {[],St};
lc_guard_tests(Gs0, St0) ->
Gs1 = guard_tests(Gs0),
{Gs,St} = gexpr_top(Gs1, St0#core{in_guard=true}),
{Gs,St#core{in_guard=false}}.
list_gen_pattern(P0, Line, St) ->
try
{pattern(P0, St),St}
catch
nomatch -> {nomatch,add_warning(Line, nomatch, St)}
end.
%%%
%%% Generate code to calculate the initial size for
%%% the result binary in a binary comprehension.
%%%
bc_initial_size(E, Q, St0) ->
try
{ElemSzExpr,ElemSzPre,EVs,St1} = bc_elem_size(E, St0),
{V,St2} = new_var(St1),
{GenSzExpr,GenSzPre,St3} = bc_gen_size(Q, EVs, St2),
case ElemSzExpr of
#c_literal{val=ElemSz} when ElemSz rem 8 =:= 0 ->
NumBytesExpr = #c_literal{val=ElemSz div 8},
BytesExpr = [#iset{var=V,
arg=bc_mul(GenSzExpr, NumBytesExpr)}],
{V,ElemSzPre++GenSzPre++BytesExpr,St3};
_ ->
{[BitsV,PlusSevenV],St} = new_vars(2, St3),
BitsExpr = #iset{var=BitsV,arg=bc_mul(GenSzExpr, ElemSzExpr)},
PlusSevenExpr = #iset{var=PlusSevenV,
arg=bc_add(BitsV, #c_literal{val=7})},
Expr = #iset{var=V,
arg=bc_bsr(PlusSevenV, #c_literal{val=3})},
{V,ElemSzPre++GenSzPre++
[BitsExpr,PlusSevenExpr,Expr],St}
end
catch
throw:impossible ->
{#c_literal{val=256},[],St0}
end.
bc_elem_size({bin,_,El}, St0) ->
case bc_elem_size_1(El, 0, []) of
{Bits,[]} ->
{#c_literal{val=Bits},[],[],St0};
{Bits,Vars0} ->
[{U,V0}|Pairs] = sort(Vars0),
F = bc_elem_size_combine(Pairs, U, [V0], []),
Vs = [V || {_,#c_var{name=V}} <- Vars0],
{E,Pre,St} = bc_mul_pairs(F, #c_literal{val=Bits}, [], St0),
{E,Pre,Vs,St}
end.
bc_elem_size_1([{bin_element,_,_,{integer,_,N},Flags}|Es], Bits, Vars) ->
{unit,U} = keyfind(unit, 1, Flags),
bc_elem_size_1(Es, Bits+U*N, Vars);
bc_elem_size_1([{bin_element,_,_,{var,_,Var},Flags}|Es], Bits, Vars) ->
{unit,U} = keyfind(unit, 1, Flags),
bc_elem_size_1(Es, Bits, [{U,#c_var{name=Var}}|Vars]);
bc_elem_size_1([_|_], _, _) ->
throw(impossible);
bc_elem_size_1([], Bits, Vars) ->
{Bits,Vars}.
bc_elem_size_combine([{U,V}|T], U, UVars, Acc) ->
bc_elem_size_combine(T, U, [V|UVars], Acc);
bc_elem_size_combine([{U,V}|T], OldU, UVars, Acc) ->
bc_elem_size_combine(T, U, [V], [{OldU,UVars}|Acc]);
bc_elem_size_combine([], U, Uvars, Acc) ->
[{U,Uvars}|Acc].
bc_mul_pairs([{U,L0}|T], E0, Pre, St0) ->
{AddExpr,AddPre,St1} = bc_add_list(L0, St0),
{[V1,V2],St} = new_vars(2, St1),
Set1 = #iset{var=V1,arg=bc_mul(AddExpr, #c_literal{val=U})},
Set2 = #iset{var=V2,arg=bc_add(V1, E0)},
bc_mul_pairs(T, V2, [Set2,Set1|reverse(AddPre, Pre)], St);
bc_mul_pairs([], E, Pre, St) ->
{E,reverse(Pre),St}.
bc_add_list([V], St) ->
{V,[],St};
bc_add_list([H|T], St) ->
bc_add_list_1(T, [], H, St).
bc_add_list_1([H|T], Pre, E, St0) ->
{Var,St} = new_var(St0),
Set = #iset{var=Var,arg=bc_add(H, E)},
bc_add_list_1(T, [Set|Pre], Var, St);
bc_add_list_1([], Pre, E, St) ->
{E,reverse(Pre),St}.
bc_gen_size(Q, EVs, St) ->
bc_gen_size_1(Q, EVs, #c_literal{val=1}, [], St).
bc_gen_size_1([{generate,L,El,Gen}|Qs], EVs, E0, Pre0, St0) ->
bc_verify_non_filtering(El, EVs),
case Gen of
{var,_,ListVar} ->
Lanno = lineno_anno(L, St0),
{LenVar,St1} = new_var(St0),
Set = #iset{var=LenVar,
arg=#icall{anno=#a{anno=Lanno},
module=#c_literal{val=erlang},
name=#c_literal{val=length},
args=[#c_var{name=ListVar}]}},
{E,Pre,St} = bc_gen_size_mul(E0, LenVar, [Set|Pre0], St1),
bc_gen_size_1(Qs, EVs, E, Pre, St);
_ ->
%% The only expressions we handle is literal lists.
Len = bc_list_length(Gen, 0),
{E,Pre,St} = bc_gen_size_mul(E0, #c_literal{val=Len}, Pre0, St0),
bc_gen_size_1(Qs, EVs, E, Pre, St)
end;
bc_gen_size_1([{b_generate,_,El,Gen}|Qs], EVs, E0, Pre0, St0) ->
bc_verify_non_filtering(El, EVs),
{MatchSzExpr,Pre1,_,St1} = bc_elem_size(El, St0),
Pre2 = reverse(Pre1, Pre0),
{ResVar,St2} = new_var(St1),
{BitSizeExpr,Pre3,St3} = bc_gen_bit_size(Gen, Pre2, St2),
Div = #iset{var=ResVar,arg=bc_div(BitSizeExpr,
MatchSzExpr)},
Pre4 = [Div|Pre3],
{E,Pre,St} = bc_gen_size_mul(E0, ResVar, Pre4, St3),
bc_gen_size_1(Qs, EVs, E, Pre, St);
bc_gen_size_1([], _, E, Pre, St) ->
{E,reverse(Pre),St};
bc_gen_size_1(_, _, _, _, _) ->
throw(impossible).
bc_gen_bit_size({var,L,V}, Pre0, St0) ->
Lanno = lineno_anno(L, St0),
{SzVar,St} = new_var(St0),
Pre = [#iset{var=SzVar,
arg=#icall{anno=#a{anno=Lanno},
module=#c_literal{val=erlang},
name=#c_literal{val=bit_size},
args=[#c_var{name=V}]}}|Pre0],
{SzVar,Pre,St};
bc_gen_bit_size({bin,_,_}=Bin, Pre, St) ->
{#c_literal{val=bc_bin_size(Bin)},Pre,St};
bc_gen_bit_size(_, _, _) ->
throw(impossible).
bc_verify_non_filtering({bin,_,Els}, EVs) ->
foreach(fun({bin_element,_,{var,_,V},_,_}) ->
case member(V, EVs) of
true -> throw(impossible);
false -> ok
end;
(_) -> throw(impossible)
end, Els);
bc_verify_non_filtering({var,_,V}, EVs) ->
case member(V, EVs) of
true -> throw(impossible);
false -> ok
end;
bc_verify_non_filtering(_, _) ->
throw(impossible).
bc_list_length({string,_,Str}, Len) ->
Len + length(Str);
bc_list_length({cons,_,_,T}, Len) ->
bc_list_length(T, Len+1);
bc_list_length({nil,_}, Len) ->
Len;
bc_list_length(_, _) ->
throw(impossible).
bc_bin_size({bin,_,Els}) ->
bc_bin_size_1(Els, 0).
bc_bin_size_1([{bin_element,_,_,{integer,_,Sz},Flags}|Els], N) ->
{unit,U} = keyfind(unit, 1, Flags),
bc_bin_size_1(Els, N+U*Sz);
bc_bin_size_1([], N) -> N;
bc_bin_size_1(_, _) -> throw(impossible).
bc_gen_size_mul(#c_literal{val=1}, E, Pre, St) ->
{E,Pre,St};
bc_gen_size_mul(E1, E2, Pre, St0) ->
{V,St} = new_var(St0),
{V,[#iset{var=V,arg=bc_mul(E1, E2)}|Pre],St}.
bc_mul(E1, #c_literal{val=1}) ->
E1;
bc_mul(E1, E2) ->
#icall{module=#c_literal{val=erlang},
name=#c_literal{val='*'},
args=[E1,E2]}.
bc_div(E1, E2) ->
#icall{module=#c_literal{val=erlang},
name=#c_literal{val='div'},
args=[E1,E2]}.
bc_add(E1, #c_literal{val=0}) ->
E1;
bc_add(E1, E2) ->
#icall{module=#c_literal{val=erlang},
name=#c_literal{val='+'},
args=[E1,E2]}.
bc_bsr(E1, E2) ->
#icall{module=#c_literal{val=erlang},
name=#c_literal{val='bsr'},
args=[E1,E2]}.
%% is_guard_test(Expression) -> true | false.
%% Test if a general expression is a guard test. Use erl_lint here
%% as it now allows sys_pre_expand transformed source.
is_guard_test(E) -> erl_lint:is_guard_test(E).
%% novars(Expr, State) -> {Novars,[PreExpr],State}.
%% Generate a novars expression, basically a call or a safe. At this
%% level we do not need to do a deep check.
novars(E0, St0) ->
{E1,Eps,St1} = expr(E0, St0),
{Se,Sps,St2} = force_novars(E1, St1),
{Se,Eps ++ Sps,St2}.
force_novars(#iapply{}=App, St) -> {App,[],St};
force_novars(#icall{}=Call, St) -> {Call,[],St};
force_novars(#ifun{}=Fun, St) -> {Fun,[],St}; %These are novars too
force_novars(#ibinary{}=Bin, St) -> {Bin,[],St};
force_novars(Ce, St) ->
force_safe(Ce, St).
%% safe(Expr, State) -> {Safe,[PreExpr],State}.
%% Generate an internal safe expression. These are simples without
%% binaries which can fail. At this level we do not need to do a
%% deep check. Must do special things with matches here.
safe(E0, St0) ->
{E1,Eps,St1} = expr(E0, St0),
{Se,Sps,St2} = force_safe(E1, St1),
{Se,Eps ++ Sps,St2}.
safe_list(Es, St) ->
foldr(fun (E, {Ces,Esp,St0}) ->
{Ce,Ep,St1} = safe(E, St0),
{[Ce|Ces],Ep ++ Esp,St1}
end, {[],[],St}, Es).
force_safe(#imatch{pat=P,arg=E}=Imatch, St0) ->
{Le,Lps0,St1} = force_safe(E, St0),
Lps = Lps0 ++ [Imatch#imatch{arg=Le}],
%% Make sure we don't duplicate the expression E. sys_core_fold
%% will usually optimize away the duplicate expression, but may
%% generate a warning while doing so.
case Le of
#c_var{} ->
%% Le is a variable.
%% Thus: P = Le, Le. (Traditional, since the V2 compiler.)
{Le,Lps,St1};
_ ->
%% Le is not a variable.
%% Thus: NewVar = P = Le, NewVar. (New for R12B-1.)
%%
%% Note: It is tempting to rewrite V = Le to V = Le, V,
%% but that will generate extra warnings in sys_core_fold
%% for this expression:
%%
%% [{X,Y} || {X,_} <- E, (Y = X) =:= (Y = 1 + 1)]
%%
%% (There will be a 'case Y =:= Y of...' which will generate
%% a warning.)
{V,St2} = new_var(St1),
{V,Lps0 ++ [Imatch#imatch{pat=#c_alias{var=V,pat=P},arg=Le}],St2}
end;
force_safe(Ce, St0) ->
case is_safe(Ce) of
true -> {Ce,[],St0};
false ->
{V,St1} = new_var(St0),
{V,[#iset{var=V,arg=Ce}],St1}
end.
is_safe(#c_cons{}) -> true;
is_safe(#c_tuple{}) -> true;
is_safe(#c_var{}) -> true;
is_safe(#c_literal{}) -> true;
is_safe(_) -> false.
%% fold_match(MatchExpr, Pat) -> {MatchPat,Expr}.
%% Fold nested matches into one match with aliased patterns.
fold_match({match,L,P0,E0}, P) ->
{P1,E1} = fold_match(E0, P),
{{match,L,P0,P1},E1};
fold_match(E, P) -> {P,E}.
%% pattern(Pattern, State) -> CorePat.
%% Transform a pattern by removing line numbers. We also normalise
%% aliases in patterns to standard form, {alias,Pat,[Var]}.
pattern({var,L,V}, St) -> #c_var{anno=lineno_anno(L, St),name=V};
pattern({char,L,C}, St) -> #c_literal{anno=lineno_anno(L, St),val=C};
pattern({integer,L,I}, St) -> #c_literal{anno=lineno_anno(L, St),val=I};
pattern({float,L,F}, St) -> #c_literal{anno=lineno_anno(L, St),val=F};
pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A};
pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S};
pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]};
pattern({cons,L,H,T}, St) ->
ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St));
pattern({tuple,L,Ps}, St) ->
ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St));
pattern({map,L,Ps}, St) ->
#c_map{anno=lineno_anno(L, St), es=sort(pattern_list(Ps, St))};
pattern({map_field_exact,L,K,V}, St) ->
%% FIXME: Better way to construct literals? or missing case
%% {Key,_,_} = expr(K, St),
Key = case K of
{bin,L,Es0} ->
case constant_bin(Es0) of
error ->
throw(badmatch);
Bin ->
#c_literal{anno=lineno_anno(L,St),val=Bin}
end;
_ ->
pattern(K,St)
end,
#c_map_pair{anno=lineno_anno(L, St),
op=#c_literal{val=exact},
key=Key,
val=pattern(V, St)};
pattern({bin,L,Ps}, St) ->
%% We don't create a #ibinary record here, since there is
%% no need to hold any used/new annotations in a pattern.
#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)};
pattern({match,_,P1,P2}, St) ->
pat_alias(pattern(P1, St), pattern(P2, St)).
%% pat_bin([BinElement], State) -> [BinSeg].
pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps].
pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) ->
#c_bitstr{val=pattern(Term, St),size=pattern(Size, St),
unit=#c_literal{val=Unit},
type=#c_literal{val=Type},
flags=#c_literal{val=Flags}}.
%% pat_alias(CorePat, CorePat) -> AliasPat.
%% Normalise aliases. Trap bad aliases by throwing 'nomatch'.
pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2};
pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1};
pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) ->
pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H},
S#c_literal{val=T}));
pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) ->
pat_alias(ann_c_cons_skel(A, #c_literal{anno=A,val=H},
S#c_literal{val=T}), Cons);
pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) ->
ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2));
pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) ->
Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)],
ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) ->
Es1 = [#c_literal{val=E} || E <- tuple_to_list(T)],
ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) ->
ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
pat_alias(#c_alias{var=V1,pat=P1},
#c_alias{var=V2,pat=P2}) ->
if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)};
true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}}
end;
pat_alias(#c_alias{var=V1,pat=P1}, P2) ->
#c_alias{var=V1,pat=pat_alias(P1, P2)};
pat_alias(P1, #c_alias{var=V2,pat=P2}) ->
#c_alias{var=V2,pat=pat_alias(P1, P2)};
pat_alias(P1, P2) ->
case {set_anno(P1, []),set_anno(P2, [])} of
{P,P} -> P;
_ -> throw(nomatch)
end.
%% pat_alias_list([A1], [A2]) -> [A].
pat_alias_list([A1|A1s], [A2|A2s]) ->
[pat_alias(A1, A2)|pat_alias_list(A1s, A2s)];
pat_alias_list([], []) -> [];
pat_alias_list(_, _) -> throw(nomatch).
%% pattern_list([P], State) -> [P].
pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps].
%% first([A]) -> [A].
%% last([A]) -> A.
first([_]) -> [];
first([H|T]) -> [H|first(T)].
last([L]) -> L;
last([_|T]) -> last(T).
%% make_vars([Name]) -> [{Var,Name}].
make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ].
%% new_fun_name(Type, State) -> {FunName,State}.
new_fun_name(Type, #core{fcount=C}=St) ->
{list_to_atom(Type ++ "$^" ++ integer_to_list(C)),St#core{fcount=C+1}}.
%% new_var_name(State) -> {VarName,State}.
new_var_name(#core{vcount=C}=St) ->
{list_to_atom("cor" ++ integer_to_list(C)),St#core{vcount=C + 1}}.
%% new_var(State) -> {{var,Name},State}.
%% new_var(LineAnno, State) -> {{var,Name},State}.
new_var(St) ->
new_var([], St).
new_var(Anno, St0) ->
{New,St} = new_var_name(St0),
{#c_var{anno=Anno,name=New},St}.
%% new_vars(Count, State) -> {[Var],State}.
%% new_vars(Anno, Count, State) -> {[Var],State}.
%% Make Count new variables.
new_vars(N, St) -> new_vars_1(N, [], St, []).
new_vars(Anno, N, St) -> new_vars_1(N, Anno, St, []).
new_vars_1(N, Anno, St0, Vs) when N > 0 ->
{V,St1} = new_var(Anno, St0),
new_vars_1(N-1, Anno, St1, [V|Vs]);
new_vars_1(0, _, St, Vs) -> {Vs,St}.
function_clause(Ps, LineAnno, Name) ->
FcAnno = [{function_name,Name}|LineAnno],
fail_clause(Ps, FcAnno,
ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])).
fail_clause(Pats, Anno, Arg) ->
#iclause{anno=#a{anno=[compiler_generated]},
pats=Pats,guard=[],
body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail},
args=[Arg]}]}.
ubody(B, St) -> uexpr(B, [], St).
%% uclauses([Lclause], [KnownVar], State) -> {[Lclause],State}.
uclauses(Lcs, Ks, St0) ->
mapfoldl(fun (Lc, St) -> uclause(Lc, Ks, St) end, St0, Lcs).
%% uclause(Lclause, [KnownVar], State) -> {Lclause,State}.
uclause(Cl0, Ks, St0) ->
{Cl1,_Pvs,Used,New,St1} = uclause(Cl0, Ks, Ks, St0),
A0 = get_ianno(Cl1),
A = A0#a{us=Used,ns=New},
{Cl1#iclause{anno=A},St1}.
uclause(#iclause{anno=Anno,pats=Ps0,guard=G0,body=B0}, Pks, Ks0, St0) ->
{Ps1,Pg,Pvs,Pus,St1} = upattern_list(Ps0, Pks, St0),
Pu = union(Pus, intersection(Pvs, Ks0)),
Pn = subtract(Pvs, Pu),
Ks1 = union(Pn, Ks0),
{G1,St2} = uguard(Pg, G0, Ks1, St1),
Gu = used_in_any(G1),
Gn = new_in_any(G1),
Ks2 = union(Gn, Ks1),
{B1,St3} = uexprs(B0, Ks2, St2),
Used = intersection(union([Pu,Gu,used_in_any(B1)]), Ks0),
New = union([Pn,Gn,new_in_any(B1)]),
{#iclause{anno=Anno,pats=Ps1,guard=G1,body=B1},Pvs,Used,New,St3}.
%% uguard([Test], [Kexpr], [KnownVar], State) -> {[Kexpr],State}.
%% Build a guard expression list by folding in the equality tests.
uguard([], [], _, St) -> {[],St};
uguard(Pg, [], Ks, St) ->
%% No guard, so fold together equality tests.
uguard(first(Pg), [last(Pg)], Ks, St);
uguard(Pg, Gs0, Ks, St0) ->
%% Gs0 must contain at least one element here.
{Gs3,St5} = foldr(fun (T, {Gs1,St1}) ->
{L,St2} = new_var(St1),
{R,St3} = new_var(St2),
{[#iset{var=L,arg=T}] ++ first(Gs1) ++
[#iset{var=R,arg=last(Gs1)},
#icall{anno=#a{}, %Must have an #a{}
module=#c_literal{val=erlang},
name=#c_literal{val='and'},
args=[L,R]}],
St3}
end, {Gs0,St0}, Pg),
%%ok = io:fwrite("core ~w: ~p~n", [?LINE,Gs3]),
uexprs(Gs3, Ks, St5).
%% uexprs([Kexpr], [KnownVar], State) -> {[Kexpr],State}.
uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) ->
%% Optimise for simple set of unbound variable.
case upattern(P0, Ks, St0) of
{#c_var{},[],_Pvs,_Pus,_} ->
%% Throw our work away and just set to iset.
uexprs([#iset{var=P0,arg=Arg}|Les], Ks, St0);
_Other ->
%% Throw our work away and set to icase.
if
Les =:= [] ->
%% Need to explicitly return match "value", make
%% safe for efficiency.
{La0,Lps,St1} = force_safe(Arg, St0),
La = mark_compiler_generated(La0),
Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]},
uexprs(Lps ++ [#icase{anno=A,
args=[La0],clauses=[Mc],fc=Fc}], Ks, St1);
true ->
Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les},
uexprs([#icase{anno=A,args=[Arg],
clauses=[Mc],fc=Fc}], Ks, St0)
end
end;
uexprs([Le0|Les0], Ks, St0) ->
{Le1,St1} = uexpr(Le0, Ks, St0),
{Les1,St2} = uexprs(Les0, union((get_anno(Le1))#a.ns, Ks), St1),
{[Le1|Les1],St2};
uexprs([], _, St) -> {[],St}.
%% Mark a "safe" as compiler-generated.
mark_compiler_generated(#c_cons{anno=A,hd=H,tl=T}) ->
ann_c_cons([compiler_generated|A], mark_compiler_generated(H),
mark_compiler_generated(T));
mark_compiler_generated(#c_tuple{anno=A,es=Es0}) ->
Es = [mark_compiler_generated(E) || E <- Es0],
ann_c_tuple([compiler_generated|A], Es);
mark_compiler_generated(#c_var{anno=A}=Var) ->
Var#c_var{anno=[compiler_generated|A]};
mark_compiler_generated(#c_literal{anno=A}=Lit) ->
Lit#c_literal{anno=[compiler_generated|A]}.
uexpr(#iset{anno=A,var=V,arg=A0}, Ks, St0) ->
{A1,St1} = uexpr(A0, Ks, St0),
{#iset{anno=A#a{us=del_element(V#c_var.name, (get_anno(A1))#a.us),
ns=add_element(V#c_var.name, (get_anno(A1))#a.ns)},
var=V,arg=A1},St1};
%% imatch done in uexprs.
uexpr(#iletrec{anno=A,defs=Fs0,body=B0}, Ks, St0) ->
%%ok = io:fwrite("~w: ~p~n", [?LINE,{Fs0,B0}]),
{Fs1,St1} = mapfoldl(fun ({Name,F0}, S0) ->
{F1,S1} = uexpr(F0, Ks, S0),
{{Name,F1},S1}
end, St0, Fs0),
{B1,St2} = uexprs(B0, Ks, St1),
Used = used_in_any(map(fun ({_,F}) -> F end, Fs1) ++ B1),
{#iletrec{anno=A#a{us=Used,ns=[]},defs=Fs1,body=B1},St2};
uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) ->
%% As0 will never generate new variables.
{As1,St1} = uexpr_list(As0, Ks, St0),
{Cs1,St2} = uclauses(Cs0, Ks, St1),
{Fc1,St3} = uclause(Fc0, Ks, St2),
Used = union(used_in_any(As1), used_in_any(Cs1)),
New = new_in_all(Cs1),
{#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3};
uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) ->
Avs = lit_list_vars(As),
Ks1 = case Name of
unnamed -> Ks0;
{named,FName} -> union(subtract([FName], Avs), Ks0)
end,
Ks2 = union(Avs, Ks1),
{Cs1,St1} = ufun_clauses(Cs0, Ks2, St0),
{Fc1,St2} = ufun_clause(Fc0, Ks2, St1),
Used = subtract(intersection(used_in_any(Cs1), Ks1), Avs),
A1 = A0#a{us=Used,ns=[]},
{#ifun{anno=A1,id=Id,vars=As,clauses=Cs1,fc=Fc1,name=Name},St2};
uexpr(#iapply{anno=A,op=Op,args=As}, _, St) ->
Used = union(lit_vars(Op), lit_list_vars(As)),
{#iapply{anno=A#a{us=Used},op=Op,args=As},St};
uexpr(#iprimop{anno=A,name=Name,args=As}, _, St) ->
Used = lit_list_vars(As),
{#iprimop{anno=A#a{us=Used},name=Name,args=As},St};
uexpr(#icall{anno=A,module=Mod,name=Name,args=As}, _, St) ->
Used = union([lit_vars(Mod),lit_vars(Name),lit_list_vars(As)]),
{#icall{anno=A#a{us=Used},module=Mod,name=Name,args=As},St};
uexpr(#itry{anno=A,args=As0,vars=Vs,body=Bs0,evars=Evs,handler=Hs0}, Ks, St0) ->
%% Note that we export only from body and exception.
{As1,St1} = uexprs(As0, Ks, St0),
{Bs1,St2} = uexprs(Bs0, Ks, St1),
{Hs1,St3} = uexprs(Hs0, Ks, St2),
Used = intersection(used_in_any(Bs1++Hs1++As1), Ks),
New = new_in_all(Bs1++Hs1),
{#itry{anno=A#a{us=Used,ns=New},
args=As1,vars=Vs,body=Bs1,evars=Evs,handler=Hs1},St3};
uexpr(#icatch{anno=A,body=Es0}, Ks, St0) ->
{Es1,St1} = uexprs(Es0, Ks, St0),
{#icatch{anno=A#a{us=used_in_any(Es1)},body=Es1},St1};
uexpr(#ireceive1{anno=A,clauses=Cs0}, Ks, St0) ->
{Cs1,St1} = uclauses(Cs0, Ks, St0),
{#ireceive1{anno=A#a{us=used_in_any(Cs1),ns=new_in_all(Cs1)},
clauses=Cs1},St1};
uexpr(#ireceive2{anno=A,clauses=Cs0,timeout=Te0,action=Tes0}, Ks, St0) ->
%% Te0 will never generate new variables.
{Te1,St1} = uexpr(Te0, Ks, St0),
{Cs1,St2} = uclauses(Cs0, Ks, St1),
{Tes1,St3} = uexprs(Tes0, Ks, St2),
Used = union([used_in_any(Cs1),used_in_any(Tes1),(get_anno(Te1))#a.us]),
New = case Cs1 of
[] -> new_in_any(Tes1);
_ -> intersection(new_in_all(Cs1), new_in_any(Tes1))
end,
{#ireceive2{anno=A#a{us=Used,ns=New},
clauses=Cs1,timeout=Te1,action=Tes1},St3};
uexpr(#iprotect{anno=A,body=Es0}, Ks, St0) ->
{Es1,St1} = uexprs(Es0, Ks, St0),
Used = used_in_any(Es1),
{#iprotect{anno=A#a{us=Used},body=Es1},St1}; %No new variables escape!
uexpr(#ibinary{anno=A,segments=Ss}, _, St) ->
Used = bitstr_vars(Ss),
{#ibinary{anno=A#a{us=Used},segments=Ss},St};
uexpr(#c_literal{}=Lit, _, St) ->
Anno = get_anno(Lit),
{set_anno(Lit, #a{us=[],anno=Anno}),St};
uexpr(Lit, _, St) ->
true = is_simple(Lit), %Sanity check!
Vs = lit_vars(Lit),
Anno = get_anno(Lit),
{set_anno(Lit, #a{us=Vs,anno=Anno}),St}.
uexpr_list(Les0, Ks, St0) ->
mapfoldl(fun (Le, St) -> uexpr(Le, Ks, St) end, St0, Les0).
%% ufun_clauses([Lclause], [KnownVar], State) -> {[Lclause],State}.
ufun_clauses(Lcs, Ks, St0) ->
mapfoldl(fun (Lc, St) -> ufun_clause(Lc, Ks, St) end, St0, Lcs).
%% ufun_clause(Lclause, [KnownVar], State) -> {Lclause,State}.
ufun_clause(Cl0, Ks, St0) ->
{Cl1,Pvs,Used,_,St1} = uclause(Cl0, [], Ks, St0),
A0 = get_ianno(Cl1),
A = A0#a{us=subtract(intersection(Used, Ks), Pvs),ns=[]},
{Cl1#iclause{anno=A},St1}.
%% upattern(Pat, [KnownVar], State) ->
%% {Pat,[GuardTest],[NewVar],[UsedVar],State}.
upattern(#c_var{name='_'}, _, St0) ->
{New,St1} = new_var_name(St0),
{#c_var{name=New},[],[New],[],St1};
upattern(#c_var{name=V}=Var, Ks, St0) ->
case is_element(V, Ks) of
true ->
{N,St1} = new_var_name(St0),
New = #c_var{name=N},
Test = #icall{anno=#a{us=add_element(N, [V])},
module=#c_literal{val=erlang},
name=#c_literal{val='=:='},
args=[New,Var]},
%% Test doesn't need protecting.
{New,[Test],[N],[],St1};
false -> {Var,[],[V],[],St0}
end;
upattern(#c_cons{hd=H0,tl=T0}=Cons, Ks, St0) ->
{H1,Hg,Hv,Hu,St1} = upattern(H0, Ks, St0),
{T1,Tg,Tv,Tu,St2} = upattern(T0, union(Hv, Ks), St1),
{Cons#c_cons{hd=H1,tl=T1},Hg ++ Tg,union(Hv, Tv),union(Hu, Tu),St2};
upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0),
{Tuple#c_tuple{es=Es1},Esg,Esv,Eus,St1};
upattern(#c_map{es=Es0}=Map, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0),
{Map#c_map{es=Es1},Esg,Esv,Eus,St1};
upattern(#c_map_pair{op=#c_literal{val=exact},val=V0}=MapPair, Ks, St0) ->
{V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0),
{MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1};
upattern(#c_binary{segments=Es0}=Bin, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0),
{Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1};
upattern(#c_alias{var=V0,pat=P0}=Alias, Ks, St0) ->
{V1,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0),
{P1,Pg,Pv,Pu,St2} = upattern(P0, union(Vv, Ks), St1),
{Alias#c_alias{var=V1,pat=P1},Vg ++ Pg,union(Vv, Pv),union(Vu, Pu),St2};
upattern(Other, _, St) -> {Other,[],[],[],St}. %Constants
%% upattern_list([Pat], [KnownVar], State) ->
%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}.
upattern_list([P0|Ps0], Ks, St0) ->
{P1,Pg,Pv,Pu,St1} = upattern(P0, Ks, St0),
{Ps1,Psg,Psv,Psu,St2} = upattern_list(Ps0, union(Pv, Ks), St1),
{[P1|Ps1],Pg ++ Psg,union(Pv, Psv),union(Pu, Psu),St2};
upattern_list([], _, St) -> {[],[],[],[],St}.
%% upat_bin([Pat], [KnownVar], State) ->
%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}.
upat_bin(Es0, Ks, St0) ->
{Es1,Pg,Pv,Pu0,St1} = upat_bin(Es0, Ks, [], St0),
%% In a clause such as <<Sz:8,V:Sz>> in a function head, Sz will both
%% be new and used; a situation that is not handled properly by
%% uclause/4. (Basically, since Sz occurs in two sets that are
%% subtracted from each other, Sz will not be added to the list of
%% known variables and will seem to be new the next time it is
%% used in a match.)
%% Since the variable Sz really is new (it does not use a
%% value bound prior to the binary matching), Sz should only be
%% included in the set of new variables. Thus we should take it
%% out of the set of used variables.
Pu1 = subtract(Pu0, intersection(Pv, Pu0)),
{Es1,Pg,Pv,Pu1,St1}.
%% upat_bin([Pat], [KnownVar], [LocalVar], State) ->
%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}.
upat_bin([P0|Ps0], Ks, Bs, St0) ->
{P1,Pg,Pv,Pu,Bs1,St1} = upat_element(P0, Ks, Bs, St0),
{Ps1,Psg,Psv,Psu,St2} = upat_bin(Ps0, union(Pv, Ks), Bs1, St1),
{[P1|Ps1],Pg ++ Psg,union(Pv, Psv),union(Pu, Psu),St2};
upat_bin([], _, _, St) -> {[],[],[],[],St}.
%% upat_element(Segment, [KnownVar], [LocalVar], State) ->
%% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State}
upat_element(#c_bitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) ->
{H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0),
Bs1 = case H0 of
#c_var{name=Hname} ->
case H1 of
#c_var{name=Hname} ->
Bs0;
#c_var{name=Other} ->
[{Hname,Other}|Bs0]
end;
_ ->
Bs0
end,
{Sz1,Us} = case Sz0 of
#c_var{name=Vname} ->
rename_bitstr_size(Vname, Bs0);
_Other ->
{Sz0,[]}
end,
{Seg#c_bitstr{val=H1,size=Sz1},Hg,Hv,Us,Bs1,St1}.
rename_bitstr_size(V, [{V,N}|_]) ->
New = #c_var{name=N},
{New,[N]};
rename_bitstr_size(V, [_|Rest]) ->
rename_bitstr_size(V, Rest);
rename_bitstr_size(V, []) ->
Old = #c_var{name=V},
{Old,[V]}.
used_in_any(Les) ->
foldl(fun (Le, Ns) -> union((get_anno(Le))#a.us, Ns) end,
[], Les).
new_in_any(Les) ->
foldl(fun (Le, Ns) -> union((get_anno(Le))#a.ns, Ns) end,
[], Les).
new_in_all([Le|Les]) ->
foldl(fun (L, Ns) -> intersection((get_anno(L))#a.ns, Ns) end,
(get_anno(Le))#a.ns, Les);
new_in_all([]) -> [].
%% The AfterVars are the variables which are used afterwards. We need
%% this to work out which variables are actually exported and used
%% from case/receive. In subblocks/clauses the AfterVars of the block
%% are just the exported variables.
cbody(B0, St0) ->
{B1,_,_,St1} = cexpr(B0, [], St0),
{B1,St1}.
%% cclause(Lclause, [AfterVar], State) -> {Cclause,State}.
%% The AfterVars are the exported variables.
cclause(#iclause{anno=#a{anno=Anno},pats=Ps,guard=G0,body=B0}, Exp, St0) ->
{B1,_Us1,St1} = cexprs(B0, Exp, St0),
{G1,St2} = cguard(G0, St1),
{#c_clause{anno=Anno,pats=Ps,guard=G1,body=B1},St2}.
cclauses(Lcs, Es, St0) ->
mapfoldl(fun (Lc, St) -> cclause(Lc, Es, St) end, St0, Lcs).
cguard([], St) -> {#c_literal{val=true},St};
cguard(Gs, St0) ->
{G,_,St1} = cexprs(Gs, [], St0),
{G,St1}.
%% cexprs([Lexpr], [AfterVar], State) -> {Cexpr,[AfterVar],State}.
%% Must be sneaky here at the last expr when combining exports for the
%% whole sequence and exports for that expr.
cexprs([#iset{var=#c_var{name=Name}=Var}=Iset], As, St) ->
%% Make return value explicit, and make Var true top level.
cexprs([Iset,Var#c_var{anno=#a{us=[Name]}}], As, St);
cexprs([Le], As, St0) ->
{Ce,Es,Us,St1} = cexpr(Le, As, St0),
Exp = make_vars(As), %The export variables
if
Es =:= [] -> {core_lib:make_values([Ce|Exp]),union(Us, As),St1};
true ->
{R,St2} = new_var(St1),
{#c_let{anno=get_lineno_anno(Ce),
vars=[R|make_vars(Es)],arg=Ce,
body=core_lib:make_values([R|Exp])},
union(Us, As),St2}
end;
cexprs([#iset{anno=#a{anno=A},var=V,arg=A0}|Les], As0, St0) ->
{Ces,As1,St1} = cexprs(Les, As0, St0),
{A1,Es,Us,St2} = cexpr(A0, As1, St1),
{#c_let{anno=A,vars=[V|make_vars(Es)],arg=A1,body=Ces},
union(Us, As1),St2};
cexprs([Le|Les], As0, St0) ->
{Ces,As1,St1} = cexprs(Les, As0, St0),
{Ce,Es,Us,St2} = cexpr(Le, As1, St1),
if
Es =:= [] ->
{#c_seq{arg=Ce,body=Ces},union(Us, As1),St2};
true ->
{R,St3} = new_var(St2),
{#c_let{vars=[R|make_vars(Es)],arg=Ce,body=Ces},
union(Us, As1),St3}
end.
%% cexpr(Lexpr, [AfterVar], State) -> {Cexpr,[ExpVar],[UsedVar],State}.
cexpr(#iletrec{anno=A,defs=Fs0,body=B0}, As, St0) ->
{Fs1,{_,St1}} = mapfoldl(fun ({{_Name,_Arity}=NA,F0}, {Used,S0}) ->
{F1,[],Us,S1} = cexpr(F0, [], S0),
{{#c_var{name=NA},F1},
{union(Us, Used),S1}}
end, {[],St0}, Fs0),
Exp = intersection(A#a.ns, As),
{B1,_Us,St2} = cexprs(B0, Exp, St1),
{#c_letrec{anno=A#a.anno,defs=Fs1,body=B1},Exp,A#a.us,St2};
cexpr(#icase{anno=A,args=Largs,clauses=Lcs,fc=Lfc}, As, St0) ->
Exp = intersection(A#a.ns, As), %Exports
{Cargs,St1} = foldr(fun (La, {Cas,Sta}) ->
{Ca,[],_Us1,Stb} = cexpr(La, As, Sta),
{[Ca|Cas],Stb}
end, {[],St0}, Largs),
{Ccs,St2} = cclauses(Lcs, Exp, St1),
{Cfc,St3} = cclause(Lfc, [], St2), %Never exports
{#c_case{anno=A#a.anno,
arg=core_lib:make_values(Cargs),clauses=Ccs ++ [Cfc]},
Exp,A#a.us,St3};
cexpr(#ireceive1{anno=A,clauses=Lcs}, As, St0) ->
Exp = intersection(A#a.ns, As), %Exports
{Ccs,St1} = cclauses(Lcs, Exp, St0),
{#c_receive{anno=A#a.anno,
clauses=Ccs,
timeout=#c_literal{val=infinity},action=#c_literal{val=true}},
Exp,A#a.us,St1};
cexpr(#ireceive2{anno=A,clauses=Lcs,timeout=Lto,action=Les}, As, St0) ->
Exp = intersection(A#a.ns, As), %Exports
{Cto,[],_Us1,St1} = cexpr(Lto, As, St0),
{Ccs,St2} = cclauses(Lcs, Exp, St1),
{Ces,_Us2,St3} = cexprs(Les, Exp, St2),
{#c_receive{anno=A#a.anno,
clauses=Ccs,timeout=Cto,action=Ces},
Exp,A#a.us,St3};
cexpr(#itry{anno=A,args=La,vars=Vs,body=Lb,evars=Evs,handler=Lh}, As, St0) ->
Exp = intersection(A#a.ns, As), %Exports
{Ca,_Us1,St1} = cexprs(La, [], St0),
{Cb,_Us2,St2} = cexprs(Lb, Exp, St1),
{Ch,_Us3,St3} = cexprs(Lh, Exp, St2),
{#c_try{anno=A#a.anno,arg=Ca,vars=Vs,body=Cb,evars=Evs,handler=Ch},
Exp,A#a.us,St3};
cexpr(#icatch{anno=A,body=Les}, _As, St0) ->
{Ces,_Us1,St1} = cexprs(Les, [], St0), %Never export!
{#c_catch{body=Ces},[],A#a.us,St1};
cexpr(#ifun{name=unnamed}=Fun, As, St0) ->
cfun(Fun, As, St0);
cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0,
As, St0) ->
case is_element(Name, Us0) of
false ->
cfun(Fun0, As, St0);
true ->
A1 = A0#a{us=del_element(Name, Us0)},
Fun1 = Fun0#ifun{anno=A1},
{#c_fun{body=Body}=CFun0,[],Us1,St1} = cfun(Fun1, As, St0),
RecVar = #c_var{name={Name,length(Ps)}},
Let = #c_let{vars=[#c_var{name=Name}],arg=RecVar,body=Body},
CFun1 = CFun0#c_fun{body=Let},
Letrec = #c_letrec{anno=A0#a.anno,
defs=[{RecVar,CFun1}],
body=RecVar},
{Letrec,[],Us1,St1}
end;
cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) ->
{#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St};
cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) ->
{#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St};
cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) ->
{#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St};
cexpr(#iprotect{anno=A,body=Es}, _As, St0) ->
{Ce,_,St1} = cexprs(Es, [], St0),
V = #c_var{name='Try'}, %The names are arbitrary
Vs = [#c_var{name='T'},#c_var{name='R'}],
{#c_try{anno=A#a.anno,arg=Ce,vars=[V],body=V,
evars=Vs,handler=#c_literal{val=false}},
[],A#a.us,St1};
cexpr(#ibinary{anno=#a{anno=Anno,us=Us},segments=Segs}, _As, St) ->
{#c_binary{anno=Anno,segments=Segs},[],Us,St};
cexpr(#c_literal{}=Lit, _As, St) ->
Anno = get_anno(Lit),
Vs = Anno#a.us,
{set_anno(Lit, Anno#a.anno),[],Vs,St};
cexpr(Lit, _As, St) ->
true = is_simple(Lit), %Sanity check!
Anno = get_anno(Lit),
Vs = Anno#a.us,
%%Vs = lit_vars(Lit),
{set_anno(Lit, Anno#a.anno),[],Vs,St}.
cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
{Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export!
{Cfc,St2} = cclause(Lfc, [], St1),
Anno = A#a.anno,
{#c_fun{anno=Id++Anno,vars=Args,
body=#c_case{anno=Anno,
arg=set_anno(core_lib:make_values(Args), Anno),
clauses=Ccs ++ [Cfc]}},
[],A#a.us,St2}.
%% lit_vars(Literal) -> [Var].
lit_vars(Lit) -> lit_vars(Lit, []).
lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs));
lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs);
lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs);
lit_vars(_, Vs) -> Vs. %These are atomic
% lit_bin_vars(Segs, Vs) ->
% foldl(fun (#c_bitstr{val=V,size=S}, Vs0) ->
% lit_vars(V, lit_vars(S, Vs0))
% end, Vs, Segs).
lit_list_vars(Ls) -> lit_list_vars(Ls, []).
lit_list_vars(Ls, Vs) ->
foldl(fun (L, Vs0) -> lit_vars(L, Vs0) end, Vs, Ls).
bitstr_vars(Segs) ->
bitstr_vars(Segs, []).
bitstr_vars(Segs, Vs) ->
foldl(fun (#c_bitstr{val=V,size=S}, Vs0) ->
lit_vars(V, lit_vars(S, Vs0))
end, Vs, Segs).
lineno_anno(L, St) ->
{line, Line} = erl_parse:get_attribute(L, line),
if
Line < 0 ->
[-Line] ++ St#core.file ++ [compiler_generated];
true ->
[Line] ++ St#core.file
end.
get_ianno(Ce) ->
case get_anno(Ce) of
#a{}=A -> A;
A when is_list(A) -> #a{anno=A}
end.
get_lineno_anno(Ce) ->
case get_anno(Ce) of
#a{anno=A} -> A;
A when is_list(A) -> A
end.
location(L) ->
{location,Location} = erl_parse:get_attribute(L, location),
Location.
abs_line(L) ->
erl_parse:set_line(L, fun(Line) -> abs(Line) end).
neg_line(L) ->
erl_parse:set_line(L, fun(Line) -> -abs(Line) end).
%%
%% The following three functions are used both with cerl:cerl() and with i()'s
%%
-spec get_anno(cerl:cerl() | i()) -> term().
get_anno(C) -> element(2, C).
-spec set_anno(cerl:cerl() | i(), term()) -> cerl:cerl().
set_anno(C, A) -> setelement(2, C, A).
-spec is_simple(cerl:cerl() | i()) -> boolean().
is_simple(#c_var{}) -> true;
is_simple(#c_literal{}) -> true;
is_simple(#c_cons{hd=H,tl=T}) ->
is_simple(H) andalso is_simple(T);
is_simple(#c_tuple{es=Es}) -> is_simple_list(Es);
is_simple(#c_map{es=Es}) -> is_simple_list(Es);
is_simple(#c_map_pair{key=K,val=V}) ->
is_simple(K) andalso is_simple(V);
is_simple(_) -> false.
-spec is_simple_list([cerl:cerl()]) -> boolean().
is_simple_list(Es) -> lists:all(fun is_simple/1, Es).
%%%
%%% Handling of warnings.
%%%
-type err_desc() :: 'bad_binary' | 'nomatch'.
-spec format_error(err_desc()) -> nonempty_string().
format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
"binary construction will fail because of a type mismatch".
add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 ->
St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]};
add_warning(_, _, St) -> St.
