diff options
author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
---|---|---|
committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/compiler/src/core_lib.erl | |
download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/compiler/src/core_lib.erl')
-rw-r--r-- | lib/compiler/src/core_lib.erl | 229 |
1 files changed, 229 insertions, 0 deletions
diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl new file mode 100644 index 0000000000..824be9ff7f --- /dev/null +++ b/lib/compiler/src/core_lib.erl @@ -0,0 +1,229 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. 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: Core Erlang abstract syntax functions. + +-module(core_lib). + +-export([get_anno/1,set_anno/2]). +-export([is_literal/1,is_literal_list/1]). +-export([literal_value/1]). +-export([make_values/1]). +-export([is_var_used/2]). + +-include("core_parse.hrl"). + +%% +%% Generic get/set annotation that should be used only with cerl() structures. +%% +-spec get_anno(cerl:cerl()) -> term(). + +get_anno(C) -> element(2, C). + +-spec set_anno(cerl:cerl(), term()) -> cerl:cerl(). + +set_anno(C, A) -> setelement(2, C, A). + +-spec is_literal(cerl:cerl()) -> boolean(). + +is_literal(#c_literal{}) -> true; +is_literal(#c_cons{hd=H,tl=T}) -> + is_literal(H) andalso is_literal(T); +is_literal(#c_tuple{es=Es}) -> is_literal_list(Es); +is_literal(#c_binary{segments=Es}) -> is_lit_bin(Es); +is_literal(_) -> false. + +-spec is_literal_list([cerl:cerl()]) -> boolean(). + +is_literal_list(Es) -> lists:all(fun is_literal/1, Es). + +is_lit_bin(Es) -> + lists:all(fun (#c_bitstr{val=E,size=S}) -> + is_literal(E) andalso is_literal(S) + end, Es). + +%% Return the value of LitExpr. +-spec literal_value(cerl:c_literal() | cerl:c_binary() | + cerl:c_cons() | cerl:c_tuple()) -> term(). + +literal_value(#c_literal{val=V}) -> V; +literal_value(#c_binary{segments=Es}) -> + list_to_binary([literal_value_bin(Bit) || Bit <- Es]); +literal_value(#c_cons{hd=H,tl=T}) -> + [literal_value(H)|literal_value(T)]; +literal_value(#c_tuple{es=Es}) -> + list_to_tuple(literal_value_list(Es)). + +literal_value_list(Vals) -> [literal_value(V) || V <- Vals]. + +literal_value_bin(#c_bitstr{val=Val,size=Sz,unit=U,type=T,flags=Fs}) -> + %% We will only handle literals constructed by make_literal/1. + %% Could be made more general in the future if the need arises. + 8 = literal_value(Sz), + 1 = literal_value(U), + integer = literal_value(T), + [unsigned,big] = literal_value(Fs), + literal_value(Val). + +%% Make a suitable values structure, expr or values, depending on Expr. +-spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl(). + +make_values([E]) -> E; +make_values([H|_]=Es) -> #c_values{anno=get_anno(H),es=Es}; +make_values([]) -> #c_values{es=[]}; +make_values(E) -> E. + +%% Test if the variable VarName is used in Expr. +-spec is_var_used(cerl:var_name(), cerl:cerl()) -> boolean(). + +is_var_used(V, B) -> vu_expr(V, B). + +vu_expr(V, #c_values{es=Es}) -> + vu_expr_list(V, Es); +vu_expr(V, #c_var{name=V2}) -> V =:= V2; +vu_expr(V, #c_alias{var=V2,pat=Pat}) -> + %% XXX Must handle aliases in expressions because of sys_core_fold:kill_types/2, + %% that uses a pattern as if it was an expression. + V =:= V2 orelse vu_expr(V, Pat); +vu_expr(_, #c_literal{}) -> false; +vu_expr(V, #c_cons{hd=H,tl=T}) -> + vu_expr(V, H) orelse vu_expr(V, T); +vu_expr(V, #c_tuple{es=Es}) -> + vu_expr_list(V, Es); +vu_expr(V, #c_binary{segments=Ss}) -> + vu_seg_list(V, Ss); +vu_expr(V, #c_fun{vars=Vs,body=B}) -> + %% Variables in fun shadow previous variables + case vu_var_list(V, Vs) of + true -> false; + false -> vu_expr(V, B) + end; +vu_expr(V, #c_let{vars=Vs,arg=Arg,body=B}) -> + case vu_expr(V, Arg) of + true -> true; + false -> + %% Variables in let shadow previous variables. + case vu_var_list(V, Vs) of + true -> false; + false -> vu_expr(V, B) + end + end; +vu_expr(V, #c_letrec{defs=Fs,body=B}) -> + lists:any(fun ({_,Fb}) -> vu_expr(V, Fb) end, Fs) orelse vu_expr(V, B); +vu_expr(V, #c_seq{arg=Arg,body=B}) -> + vu_expr(V, Arg) orelse vu_expr(V, B); +vu_expr(V, #c_case{arg=Arg,clauses=Cs}) -> + vu_expr(V, Arg) orelse vu_clauses(V, Cs); +vu_expr(V, #c_receive{clauses=Cs,timeout=T,action=A}) -> + vu_clauses(V, Cs) orelse vu_expr(V, T) orelse vu_expr(V, A); +vu_expr(V, #c_apply{op=Op,args=As}) -> + vu_expr_list(V, [Op|As]); +vu_expr(V, #c_call{module=M,name=N,args=As}) -> + vu_expr_list(V, [M,N|As]); +vu_expr(V, #c_primop{args=As}) -> %Name is an atom + vu_expr_list(V, As); +vu_expr(V, #c_catch{body=B}) -> + vu_expr(V, B); +vu_expr(V, #c_try{arg=E,vars=Vs,body=B,evars=Evs,handler=H}) -> + case vu_expr(V, E) of + true -> true; + false -> + %% Variables shadow previous ones. + case case vu_var_list(V, Vs) of + true -> false; + false -> vu_expr(V, B) + end of + true -> true; + false -> + case vu_var_list(V, Evs) of + true -> false; + false -> vu_expr(V, H) + end + end + end. + +vu_expr_list(V, Es) -> + lists:any(fun(E) -> vu_expr(V, E) end, Es). + +vu_seg_list(V, Ss) -> + lists:any(fun (#c_bitstr{val=Val,size=Size}) -> + vu_expr(V, Val) orelse vu_expr(V, Size) + end, Ss). + +%% Have to get the pattern results right. + +-spec vu_clause(cerl:var_name(), cerl:c_clause()) -> boolean(). + +vu_clause(V, #c_clause{pats=Ps,guard=G,body=B}) -> + case vu_pattern_list(V, Ps) of + {true,_Shad} -> true; %It is used + {false,true} -> false; %Shadowed + {false,false} -> %Not affected + %% Neither used nor shadowed. Check guard and body. + vu_expr(V, G) orelse vu_expr(V, B) + end. + +-spec vu_clauses(cerl:var_name(), [cerl:c_clause()]) -> boolean(). + +vu_clauses(V, Cs) -> + lists:any(fun(C) -> vu_clause(V, C) end, Cs). + +%% vu_pattern(VarName, Pattern) -> {Used,Shadow}. +%% vu_pattern_list(VarName, [Pattern]) -> {Used,Shadow}. +%% Binaries complicate patterns as a variable can both be properly +%% used, in a bit segment size, and shadow. They can also do both. + +%% vu_pattern(V, Pat) -> vu_pattern(V, Pat, {false,false}). + +vu_pattern(V, #c_var{name=V2}, {Used,_}) -> + {Used,V =:= V2}; +vu_pattern(V, #c_cons{hd=H,tl=T}, St0) -> + case vu_pattern(V, H, St0) of + {true,_}=St1 -> St1; %Nothing more to know + St1 -> vu_pattern(V, T, St1) + end; +vu_pattern(V, #c_tuple{es=Es}, St) -> + vu_pattern_list(V, Es, St); +vu_pattern(V, #c_binary{segments=Ss}, St) -> + vu_pat_seg_list(V, Ss, St); +vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> + case vu_pattern(V, Var, St0) of + {true,_}=St1 -> St1; + St1 -> vu_pattern(V, P, St1) + end; +vu_pattern(_, _, St) -> St. + +vu_pattern_list(V, Ps) -> vu_pattern_list(V, Ps, {false,false}). + +vu_pattern_list(V, Ps, St0) -> + lists:foldl(fun(P, St) -> vu_pattern(V, P, St) end, St0, Ps). + +vu_pat_seg_list(V, Ss, St) -> + lists:foldl(fun(_, {true,_}=St0) -> St0; + (#c_bitstr{val=Val,size=Size}, St0) -> + case vu_pattern(V, Val, St0) of + {true,_}=St1 -> St1; + {false,Shad} -> + {vu_expr(V, Size),Shad} + end + end, St, Ss). + +-spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). + +vu_var_list(V, Vs) -> + lists:any(fun (#c_var{name=V2}) -> V =:= V2 end, Vs). |