1%% ``Licensed under the Apache License, Version 2.0 (the "License"); 2%% you may not use this file except in compliance with the License. 3%% You may obtain a copy of the License at 4%% 5%% http://www.apache.org/licenses/LICENSE-2.0 6%% 7%% Unless required by applicable law or agreed to in writing, software 8%% distributed under the License is distributed on an "AS IS" BASIS, 9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 10%% See the License for the specific language governing permissions and 11%% limitations under the License. 12%% 13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 15%% AB. All Rights Reserved.'' 16%% 17%% $Id: v3_core.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ 18%% Purpose : Transform normal Erlang to Core Erlang 19 20%% At this stage all preprocessing has been done. All that is left are 21%% "pure" Erlang functions. 22%% 23%% Core transformation is done in three stages: 24%% 25%% 1. Flatten expressions into an internal core form without doing 26%% matching. 27%% 28%% 2. Step "forwards" over the icore code annotating each "top-level" 29%% thing with variable usage. Detect bound variables in matching 30%% and replace with explicit guard test. Annotate "internal-core" 31%% expressions with variables they use and create. Convert matches 32%% to cases when not pure assignments. 33%% 34%% 3. Step "backwards" over icore code using variable usage 35%% annotations to change implicit exported variables to explicit 36%% returns. 37%% 38%% To ensure the evaluation order we ensure that all arguments are 39%% safe. A "safe" is basically a core_lib simple with VERY restricted 40%% binaries. 41%% 42%% We have to be very careful with matches as these create variables. 43%% While we try not to flatten things more than necessary we must make 44%% sure that all matches are at the top level. For this we use the 45%% type "novars" which are non-match expressions. Cases and receives 46%% can also create problems due to exports variables so they are not 47%% "novars" either. I.e. a novars will not export variables. 48%% 49%% Annotations in the #iset, #iletrec, and all other internal records 50%% is kept in a record, #a, not in a list as in proper core. This is 51%% easier and faster and creates no problems as we have complete control 52%% over all annotations. 53%% 54%% On output, the annotation for most Core Erlang terms will contain 55%% the source line number. A few terms will be marked with the atom 56%% atom 'compiler_generated', to indicate that the compiler has generated 57%% them and that no warning should be generated if they are optimized 58%% away. 59%% 60%% 61%% In this translation: 62%% 63%% call ops are safes 64%% call arguments are safes 65%% match arguments are novars 66%% case arguments are novars 67%% receive timeouts are novars 68%% let/set arguments are expressions 69%% fun is not a safe 70 71-module(v3_core). 72 73-export([module/2,format_error/1]). 74 75-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2]). 76-import(ordsets, [add_element/2,del_element/2,is_element/2, 77 union/1,union/2,intersection/2,subtract/2]). 78 79-include("core_parse.hrl"). 80 81-record(a, {us=[],ns=[],anno=[]}). %Internal annotation 82 83%% Internal core expressions and help functions. 84%% N.B. annotations fields in place as normal Core expressions. 85 86-record(iset, {anno=#a{},var,arg}). 87-record(iletrec, {anno=#a{},defs,body}). 88-record(imatch, {anno=#a{},pat,guard=[],arg,fc}). 89-record(icase, {anno=#a{},args,clauses,fc}). 90-record(iclause, {anno=#a{},pats,pguard=[],guard,body}). 91-record(ifun, {anno=#a{},id,vars,clauses,fc}). 92-record(iapply, {anno=#a{},op,args}). 93-record(icall, {anno=#a{},module,name,args}). 94-record(iprimop, {anno=#a{},name,args}). 95-record(itry, {anno=#a{},args,vars,body,evars,handler}). 96-record(icatch, {anno=#a{},body}). 97-record(ireceive1, {anno=#a{},clauses}). 98-record(ireceive2, {anno=#a{},clauses,timeout,action}). 99-record(iprotect, {anno=#a{},body}). 100-record(ibinary, {anno=#a{},segments}). %Not used in patterns. 101 102-record(core, {vcount=0, %Variable counter 103 fcount=0, %Function counter 104 ws=[]}). %Warnings. 105 106module({Mod,Exp,Forms}, _Opts) -> 107 Cexp = map(fun ({N,A}) -> #c_fname{id=N,arity=A} end, Exp), 108 {Kfs,As,Ws} = foldr(fun form/2, {[],[],[]}, Forms), 109 {ok,#c_module{name=#c_atom{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}. 110 111form({function,_,_,_,_}=F0, {Fs,As,Ws0}) -> 112 {F,Ws} = function(F0, Ws0), 113 {[F|Fs],As,Ws}; 114form({attribute,_,_,_}=F, {Fs,As,Ws}) -> 115 {Fs,[attribute(F)|As],Ws}. 116 117attribute({attribute,_,Name,Val}) -> 118 #c_def{name=core_lib:make_literal(Name), 119 val=core_lib:make_literal(Val)}. 120 121function({function,_,Name,Arity,Cs0}, Ws0) -> 122 %%ok = io:fwrite("~p - ", [{Name,Arity}]), 123 St0 = #core{vcount=0,ws=Ws0}, 124 {B0,St1} = body(Cs0, Arity, St0), 125 %%ok = io:fwrite("1", []), 126 %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), 127 {B1,St2} = ubody(B0, St1), 128 %%ok = io:fwrite("2", []), 129 %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), 130 {B2,#core{ws=Ws}} = cbody(B1, St2), 131 %%ok = io:fwrite("3~n", []), 132 {#c_def{name=#c_fname{id=Name,arity=Arity},val=B2},Ws}. 133 134body(Cs0, Arity, St0) -> 135 Anno = [element(2, hd(Cs0))], 136 {Args,St1} = new_vars(Anno, Arity, St0), 137 {Cs1,St2} = clauses(Cs0, St1), 138 {Ps,St3} = new_vars(Arity, St2), %Need new variables here 139 Fc = fail_clause(Ps, #c_tuple{es=[#c_atom{val=function_clause}|Ps]}), 140 {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. 141 142%% clause(Clause, State) -> {Cclause,State} | noclause. 143%% clauses([Clause], State) -> {[Cclause],State}. 144%% Convert clauses. Trap bad pattern aliases and remove clause from 145%% clause list. 146 147clauses([C0|Cs0], St0) -> 148 case clause(C0, St0) of 149 {noclause,St} -> clauses(Cs0, St); 150 {C,St1} -> 151 {Cs,St2} = clauses(Cs0, St1), 152 {[C|Cs],St2} 153 end; 154clauses([], St) -> {[],St}. 155 156clause({clause,Lc,H0,G0,B0}, St0) -> 157 case catch head(H0) of 158 {'EXIT',_}=Exit -> exit(Exit); %Propagate error 159 nomatch -> 160 St = add_warning(Lc, nomatch, St0), 161 {noclause,St}; %Bad pattern 162 H1 -> 163 {G1,St1} = guard(G0, St0), 164 {B1,St2} = exprs(B0, St1), 165 {#iclause{anno=#a{anno=[Lc]},pats=H1,guard=G1,body=B1},St2} 166 end. 167 168%% head([P]) -> [P]. 169 170head(Ps) -> pattern_list(Ps). 171 172%% guard([Expr], State) -> {[Cexpr],State}. 173%% Build an explict and/or tree of guard alternatives, then traverse 174%% top-level and/or tree and "protect" inner tests. 175 176guard([], St) -> {[],St}; 177guard(Gs0, St) -> 178 Gs = foldr(fun (Gt0, Rhs) -> 179 Gt1 = guard_tests(Gt0), 180 L = element(2, Gt1), 181 {op,L,'or',Gt1,Rhs} 182 end, guard_tests(last(Gs0)), first(Gs0)), 183 gexpr_top(Gs, St). 184 185guard_tests([]) -> []; 186guard_tests(Gs) -> 187 L = element(2, hd(Gs)), 188 {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), first(Gs))}. 189 190%% gexpr_top(Expr, State) -> {Cexpr,State}. 191%% Generate an internal core expression of a guard test. Explicitly 192%% handle outer boolean expressions and "protect" inner tests in a 193%% reasonably smart way. 194 195gexpr_top(E0, St0) -> 196 {E1,Eps0,Bools,St1} = gexpr(E0, [], St0), 197 {E,Eps,St} = force_booleans(Bools, E1, Eps0, St1), 198 {Eps++[E],St}. 199 200%% gexpr(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. 201%% Generate an internal core expression of a guard test. 202 203gexpr({protect,Line,Arg}, Bools0, St0) -> 204 case gexpr(Arg, [], St0) of 205 {E0,[],Bools,St1} -> 206 {E,Eps,St} = force_booleans(Bools, E0, [], St1), 207 {E,Eps,Bools0,St}; 208 {E0,Eps0,Bools,St1} -> 209 {E,Eps,St} = force_booleans(Bools, E0, Eps0, St1), 210 {#iprotect{anno=#a{anno=[Line]},body=Eps++[E]},[],Bools0,St} 211 end; 212gexpr({op,Line,Op,L,R}=Call, Bools0, St0) -> 213 case erl_internal:bool_op(Op, 2) of 214 true -> 215 {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0), 216 {Ll,Llps,St2} = force_safe(Le, St1), 217 {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2), 218 {Rl,Rlps,St4} = force_safe(Re, St3), 219 Anno = [Line], 220 {#icall{anno=#a{anno=Anno}, %Must have an #a{} 221 module=#c_atom{anno=Anno,val=erlang},name=#c_atom{anno=Anno,val=Op}, 222 args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}; 223 false -> 224 gexpr_test(Call, Bools0, St0) 225 end; 226gexpr({op,Line,Op,A}=Call, Bools0, St0) -> 227 case erl_internal:bool_op(Op, 1) of 228 true -> 229 {Ae,Aps,Bools,St1} = gexpr(A, Bools0, St0), 230 {Al,Alps,St2} = force_safe(Ae, St1), 231 Anno = [Line], 232 {#icall{anno=#a{anno=Anno}, %Must have an #a{} 233 module=#c_atom{anno=Anno,val=erlang},name=#c_atom{anno=Anno,val=Op}, 234 args=[Al]},Aps ++ Alps,Bools,St2}; 235 false -> 236 gexpr_test(Call, Bools0, St0) 237 end; 238gexpr(E0, Bools, St0) -> 239 gexpr_test(E0, Bools, St0). 240 241%% gexpr_test(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. 242%% Generate a guard test. At this stage we must be sure that we have 243%% a proper boolean value here so wrap things with an true test if we 244%% don't know, i.e. if it is not a comparison or a type test. 245 246gexpr_test({atom,L,true}, Bools, St0) -> 247 {#c_atom{anno=[L],val=true},[],Bools,St0}; 248gexpr_test({atom,L,false}, Bools, St0) -> 249 {#c_atom{anno=[L],val=false},[],Bools,St0}; 250gexpr_test(E0, Bools0, St0) -> 251 {E1,Eps0,St1} = expr(E0, St0), 252 %% Generate "top-level" test and argument calls. 253 case E1 of 254 #icall{anno=Anno,module=#c_atom{val=erlang},name=#c_atom{val=N},args=As} -> 255 Ar = length(As), 256 case erl_internal:type_test(N, Ar) orelse 257 erl_internal:comp_op(N, Ar) orelse 258 (N == internal_is_record andalso Ar == 3) of 259 true -> {E1,Eps0,Bools0,St1}; 260 false -> 261 Lanno = Anno#a.anno, 262 {New,St2} = new_var(Lanno, St1), 263 Bools = [New|Bools0], 264 {#icall{anno=Anno, %Must have an #a{} 265 module=#c_atom{anno=Lanno,val=erlang}, 266 name=#c_atom{anno=Lanno,val='=:='}, 267 args=[New,#c_atom{anno=Lanno,val=true}]}, 268 Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2} 269 end; 270 _ -> 271 Anno = get_ianno(E1), 272 Lanno = get_lineno_anno(E1), 273 case core_lib:is_simple(E1) of 274 true -> 275 Bools = [E1|Bools0], 276 {#icall{anno=Anno, %Must have an #a{} 277 module=#c_atom{anno=Lanno,val=erlang}, 278 name=#c_atom{anno=Lanno,val='=:='}, 279 args=[E1,#c_atom{anno=Lanno,val=true}]},Eps0,Bools,St1}; 280 false -> 281 {New,St2} = new_var(Lanno, St1), 282 Bools = [New|Bools0], 283 {#icall{anno=Anno, %Must have an #a{} 284 module=#c_atom{anno=Lanno,val=erlang}, 285 name=#c_atom{anno=Lanno,val='=:='}, 286 args=[New,#c_atom{anno=Lanno,val=true}]}, 287 Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2} 288 end 289 end. 290 291force_booleans([], E, Eps, St) -> 292 {E,Eps,St}; 293force_booleans([V|Vs], E0, Eps0, St0) -> 294 {E1,Eps1,St1} = force_safe(E0, St0), 295 Lanno = element(2, V), 296 Anno = #a{anno=Lanno}, 297 Call = #icall{anno=Anno,module=#c_atom{anno=Lanno,val=erlang}, 298 name=#c_atom{anno=Lanno,val=is_boolean}, 299 args=[V]}, 300 {New,St} = new_var(Lanno, St1), 301 Iset = #iset{anno=Anno,var=New,arg=Call}, 302 Eps = Eps0 ++ Eps1 ++ [Iset], 303 E = #icall{anno=Anno, 304 module=#c_atom{anno=Lanno,val=erlang},name=#c_atom{anno=Lanno,val='and'}, 305 args=[E1,New]}, 306 force_booleans(Vs, E, Eps, St). 307 308%% exprs([Expr], State) -> {[Cexpr],State}. 309%% Flatten top-level exprs. 310 311exprs([E0|Es0], St0) -> 312 {E1,Eps,St1} = expr(E0, St0), 313 {Es1,St2} = exprs(Es0, St1), 314 {Eps ++ [E1] ++ Es1,St2}; 315exprs([], St) -> {[],St}. 316 317%% expr(Expr, State) -> {Cexpr,[PreExp],State}. 318%% Generate an internal core expression. 319 320expr({var,L,V}, St) -> {#c_var{anno=[L],name=V},[],St}; 321expr({char,L,C}, St) -> {#c_char{anno=[L],val=C},[],St}; 322expr({integer,L,I}, St) -> {#c_int{anno=[L],val=I},[],St}; 323expr({float,L,F}, St) -> {#c_float{anno=[L],val=F},[],St}; 324expr({atom,L,A}, St) -> {#c_atom{anno=[L],val=A},[],St}; 325expr({nil,L}, St) -> {#c_nil{anno=[L]},[],St}; 326expr({string,L,S}, St) -> {#c_string{anno=[L],val=S},[],St}; 327expr({cons,L,H0,T0}, St0) -> 328 {H1,Hps,St1} = safe(H0, St0), 329 {T1,Tps,St2} = safe(T0, St1), 330 {#c_cons{anno=[L],hd=H1,tl=T1},Hps ++ Tps,St2}; 331expr({lc,L,E,Qs}, St) -> 332 lc_tq(L, E, Qs, {nil,L}, St); 333expr({tuple,L,Es0}, St0) -> 334 {Es1,Eps,St1} = safe_list(Es0, St0), 335 {#c_tuple{anno=[L],es=Es1},Eps,St1}; 336expr({bin,L,Es0}, St0) -> 337 {Es1,Eps,St1} = expr_bin(Es0, St0), 338 {#ibinary{anno=#a{anno=[L]},segments=Es1},Eps,St1}; 339expr({block,_,Es0}, St0) -> 340 %% Inline the block directly. 341 {Es1,St1} = exprs(first(Es0), St0), 342 {E1,Eps,St2} = expr(last(Es0), St1), 343 {E1,Es1 ++ Eps,St2}; 344expr({'if',L,Cs0}, St0) -> 345 {Cs1,St1} = clauses(Cs0, St0), 346 Fc = fail_clause([], #c_atom{val=if_clause}), 347 {#icase{anno=#a{anno=[L]},args=[],clauses=Cs1,fc=Fc},[],St1}; 348expr({'case',L,E0,Cs0}, St0) -> 349 {E1,Eps,St1} = novars(E0, St0), 350 {Cs1,St2} = clauses(Cs0, St1), 351 {Fpat,St3} = new_var(St2), 352 Fc = fail_clause([Fpat], #c_tuple{es=[#c_atom{val=case_clause},Fpat]}), 353 {#icase{anno=#a{anno=[L]},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; 354expr({'receive',L,Cs0}, St0) -> 355 {Cs1,St1} = clauses(Cs0, St0), 356 {#ireceive1{anno=#a{anno=[L]},clauses=Cs1}, [], St1}; 357expr({'receive',L,Cs0,Te0,Tes0}, St0) -> 358 {Te1,Teps,St1} = novars(Te0, St0), 359 {Tes1,St2} = exprs(Tes0, St1), 360 {Cs1,St3} = clauses(Cs0, St2), 361 {#ireceive2{anno=#a{anno=[L]}, 362 clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3}; 363expr({'try',L,Es0,[],Ecs,[]}, St0) -> 364 %% 'try ... catch ... end' 365 {Es1,St1} = exprs(Es0, St0), 366 {V,St2} = new_var(St1), %This name should be arbitrary 367 {Evs,Hs,St3} = try_exception(Ecs, St2), 368 {#itry{anno=#a{anno=[L]},args=Es1,vars=[V],body=[V], 369 evars=Evs,handler=Hs}, 370 [],St3}; 371expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> 372 %% 'try ... of ... catch ... end' 373 {Es1,St1} = exprs(Es0, St0), 374 {V,St2} = new_var(St1), %This name should be arbitrary 375 {Cs1,St3} = clauses(Cs0, St2), 376 {Fpat,St4} = new_var(St3), 377 Fc = fail_clause([Fpat], #c_tuple{es=[#c_atom{val=try_clause},Fpat]}), 378 {Evs,Hs,St5} = try_exception(Ecs, St4), 379 {#itry{anno=#a{anno=[L]},args=Es1, 380 vars=[V],body=[#icase{anno=#a{},args=[V],clauses=Cs1,fc=Fc}], 381 evars=Evs,handler=Hs}, 382 [],St5}; 383expr({'try',L,Es0,[],[],As0}, St0) -> 384 %% 'try ... after ... end' 385 {Es1,St1} = exprs(Es0, St0), 386 {As1,St2} = exprs(As0, St1), 387 {Evs,Hs,St3} = try_after(As1,St2), 388 {V,St4} = new_var(St3), % (must not exist in As1) 389 %% TODO: this duplicates the 'after'-code; should lift to function. 390 {#itry{anno=#a{anno=[L]},args=Es1,vars=[V],body=As1++[V], 391 evars=Evs,handler=Hs}, 392 [],St4}; 393expr({'try',L,Es,Cs,Ecs,As}, St0) -> 394 %% 'try ... [of ...] [catch ...] after ... end' 395 expr({'try',L,[{'try',L,Es,Cs,Ecs,[]}],[],[],As}, St0); 396expr({'catch',L,E0}, St0) -> 397 {E1,Eps,St1} = expr(E0, St0), 398 {#icatch{anno=#a{anno=[L]},body=Eps ++ [E1]},[],St1}; 399expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> 400 {#c_fname{anno=[L,{id,Id}],id=F,arity=A},[],St}; 401expr({'fun',L,{clauses,Cs},Id}, St) -> 402 fun_tq(Id, Cs, L, St); 403expr({call,L0,{remote,_,{atom,_,erlang},{atom,_,is_record}},[_,_,_]=As}, St) 404 when L0 < 0 -> 405 %% Compiler-generated erlang:is_record/3 should be converted to 406 %% erlang:internal_is_record/3. 407 L = -L0, 408 expr({call,L,{remote,L,{atom,L,erlang},{atom,L,internal_is_record}},As}, St); 409expr({call,L,{remote,_,M,F},As0}, St0) -> 410 {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), 411 {#icall{anno=#a{anno=[L]},module=M1,name=F1,args=As1},Aps,St1}; 412expr({call,Lc,{atom,Lf,F},As0}, St0) -> 413 {As1,Aps,St1} = safe_list(As0, St0), 414 Op = #c_fname{anno=[Lf],id=F,arity=length(As1)}, 415 {#iapply{anno=#a{anno=[Lc]},op=Op,args=As1},Aps,St1}; 416expr({call,L,FunExp,As0}, St0) -> 417 {Fun,Fps,St1} = safe(FunExp, St0), 418 {As1,Aps,St2} = safe_list(As0, St1), 419 {#iapply{anno=#a{anno=[L]},op=Fun,args=As1},Fps ++ Aps,St2}; 420expr({match,L,P0,E0}, St0) -> 421 %% First fold matches together to create aliases. 422 {P1,E1} = fold_match(E0, P0), 423 {E2,Eps,St1} = novars(E1, St0), 424 P2 = (catch pattern(P1)), 425 {Fpat,St2} = new_var(St1), 426 Fc = fail_clause([Fpat], #c_tuple{es=[#c_atom{val=badmatch},Fpat]}), 427 case P2 of 428 {'EXIT',_}=Exit -> exit(Exit); %Propagate error 429 nomatch -> 430 St = add_warning(L, nomatch, St2), 431 {#icase{anno=#a{anno=[L]}, 432 args=[E2],clauses=[],fc=Fc},Eps,St}; 433 _Other -> 434 {#imatch{anno=#a{anno=[L]},pat=P2,arg=E2,fc=Fc},Eps,St2} 435 end; 436expr({op,_,'++',{lc,Llc,E,Qs},L2}, St) -> 437 %% Optimise this here because of the list comprehension algorithm. 438 lc_tq(Llc, E, Qs, L2, St); 439expr({op,L,Op,A0}, St0) -> 440 {A1,Aps,St1} = safe(A0, St0), 441 LineAnno = [L], 442 {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} 443 module=#c_atom{anno=LineAnno,val=erlang}, 444 name=#c_atom{anno=LineAnno,val=Op},args=[A1]},Aps,St1}; 445expr({op,L,Op,L0,R0}, St0) -> 446 {As,Aps,St1} = safe_list([L0,R0], St0), 447 LineAnno = [L], 448 {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} 449 module=#c_atom{anno=LineAnno,val=erlang}, 450 name=#c_atom{anno=LineAnno,val=Op},args=As},Aps,St1}. 451 452%% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. 453 454try_exception(Ecs0, St0) -> 455 %% Note that Tag is not needed for rethrow - it is already in Info. 456 {Evs,St1} = new_vars(3, St0), % Tag, Value, Info 457 {Ecs1,St2} = clauses(Ecs0, St1), 458 [_,Value,Info] = Evs, 459 Ec = #iclause{anno=#a{anno=[compiler_generated]}, 460 pats=[#c_tuple{es=Evs}],guard=[#c_atom{val=true}], 461 body=[#iprimop{anno=#a{}, %Must have an #a{} 462 name=#c_atom{val=raise}, 463 args=[Info,Value]}]}, 464 Hs = [#icase{anno=#a{},args=[#c_tuple{es=Evs}],clauses=Ecs1,fc=Ec}], 465 {Evs,Hs,St2}. 466 467try_after(As, St0) -> 468 %% See above. 469 {Evs,St1} = new_vars(3, St0), % Tag, Value, Info 470 [_,Value,Info] = Evs, 471 B = As ++ [#iprimop{anno=#a{}, %Must have an #a{} 472 name=#c_atom{val=raise}, 473 args=[Info,Value]}], 474 Ec = #iclause{anno=#a{anno=[compiler_generated]}, 475 pats=[#c_tuple{es=Evs}],guard=[#c_atom{val=true}], 476 body=B}, 477 Hs = [#icase{anno=#a{},args=[#c_tuple{es=Evs}],clauses=[],fc=Ec}], 478 {Evs,Hs,St1}. 479 480%% expr_bin([ArgExpr], St) -> {[Arg],[PreExpr],St}. 481%% Flatten the arguments of a bin. Do this straight left to right! 482 483expr_bin(Es, St) -> 484 foldr(fun (E, {Ces,Esp,St0}) -> 485 {Ce,Ep,St1} = bitstr(E, St0), 486 {[Ce|Ces],Ep ++ Esp,St1} 487 end, {[],[],St}, Es). 488 489bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> 490 {E1,Eps,St1} = safe(E0, St0), 491 {Size1,Eps2,St2} = safe(Size0, St1), 492 {#c_bitstr{val=E1,size=Size1, 493 unit=core_lib:make_literal(Unit), 494 type=core_lib:make_literal(Type), 495 flags=core_lib:make_literal(Flags)}, 496 Eps ++ Eps2,St2}. 497 498%% fun_tq(Id, [Clauses], Line, State) -> {Fun,[PreExp],State}. 499 500fun_tq(Id, Cs0, L, St0) -> 501 {Cs1,St1} = clauses(Cs0, St0), 502 Arity = length((hd(Cs1))#iclause.pats), 503 {Args,St2} = new_vars(Arity, St1), 504 {Ps,St3} = new_vars(Arity, St2), %Need new variables here 505 Fc = fail_clause(Ps, #c_tuple{es=[#c_atom{val=function_clause}|Ps]}), 506 Fun = #ifun{anno=#a{anno=[L]}, 507 id=[{id,Id}], %We KNOW! 508 vars=Args,clauses=Cs1,fc=Fc}, 509 {Fun,[],St3}. 510 511%% lc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}. 512%% This TQ from Simon PJ pp 127-138. 513%% This gets a bit messy as we must transform all directly here. We 514%% recognise guard tests and try to fold them together and join to a 515%% preceding generators, this should give us better and more compact 516%% code. 517%% More could be transformed before calling lc_tq. 518 519lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], More, St0) -> 520 {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), 521 {Name,St1} = new_fun_name("lc", St0), 522 {Head,St2} = new_var(St1), 523 {Tname,St3} = new_var_name(St2), 524 LA = [Line], 525 LAnno = #a{anno=LA}, 526 Tail = #c_var{anno=LA,name=Tname}, 527 {Arg,St4} = new_var(St3), 528 NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, 529 {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat! 530 {Lc,Lps,St6} = lc_tq(Line, E, Qs1, NewMore, St5), 531 {Mc,Mps,St7} = expr(More, St6), 532 {Nc,Nps,St8} = expr(NewMore, St7), 533 case catch pattern(P) of 534 {'EXIT',_}=Exit -> 535 St9 = St8, 536 Pc = nomatch, 537 exit(Exit); %Propagate error 538 nomatch -> 539 St9 = add_warning(Line, nomatch, St8), 540 Pc = nomatch; 541 Pc -> 542 St9 = St8 543 end, 544 {Gc,Gps,St10} = safe(G, St9), %Will be a function argument! 545 Fc = fail_clause([Arg], #c_tuple{anno=LA, 546 es=[#c_atom{val=function_clause},Arg]}), 547 Cs0 = [#iclause{anno=#a{anno=[compiler_generated|LA]}, 548 pats=[#c_cons{anno=LA,hd=Head,tl=Tail}], 549 guard=[], 550 body=Nps ++ [Nc]}, 551 #iclause{anno=LAnno, 552 pats=[#c_nil{anno=LA}],guard=[], 553 body=Mps ++ [Mc]}], 554 Cs = case Pc of 555 nomatch -> Cs0; 556 _ -> 557 [#iclause{anno=LAnno, 558 pats=[#c_cons{anno=LA,hd=Pc,tl=Tail}], 559 guard=Guardc, 560 body=Lps ++ [Lc]}|Cs0] 561 end, 562 Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, 563 {#iletrec{anno=LAnno,defs=[{Name,Fun}], 564 body=Gps ++ [#iapply{anno=LAnno, 565 op=#c_fname{anno=LA,id=Name,arity=1}, 566 args=[Gc]}]}, 567 [],St10}; 568lc_tq(Line, E, [Fil0|Qs0], More, St0) -> 569 %% Special case sequences guard tests. 570 LA = [Line], 571 LAnno = #a{anno=LA}, 572 case is_guard_test(Fil0) of 573 true -> 574 {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), 575 {Lc,Lps,St1} = lc_tq(Line, E, Qs1, More, St0), 576 {Mc,Mps,St2} = expr(More, St1), 577 {Gs,St3} = lc_guard_tests([Fil0|Gs0], St2), %These are always flat! 578 {#icase{anno=LAnno, 579 args=[], 580 clauses=[#iclause{anno=LAnno,pats=[], 581 guard=Gs,body=Lps ++ [Lc]}], 582 fc=#iclause{anno=LAnno,pats=[],guard=[],body=Mps ++ [Mc]}}, 583 [],St3}; 584 false -> 585 {Lc,Lps,St1} = lc_tq(Line, E, Qs0, More, St0), 586 {Mc,Mps,St2} = expr(More, St1), 587 {Fpat,St3} = new_var(St2), 588 Fc = fail_clause([Fpat], #c_tuple{es=[#c_atom{val=case_clause},Fpat]}), 589 %% Do a novars little optimisation here. 590 case Fil0 of 591 {op,_,'not',Fil1} -> 592 {Filc,Fps,St4} = novars(Fil1, St3), 593 {#icase{anno=LAnno, 594 args=[Filc], 595 clauses=[#iclause{anno=LAnno, 596 pats=[#c_atom{anno=LA,val=true}], 597 guard=[], 598 body=Mps ++ [Mc]}, 599 #iclause{anno=LAnno, 600 pats=[#c_atom{anno=LA,val=false}], 601 guard=[], 602 body=Lps ++ [Lc]}], 603 fc=Fc}, 604 Fps,St4}; 605 _Other -> 606 {Filc,Fps,St4} = novars(Fil0, St3), 607 {#icase{anno=LAnno, 608 args=[Filc], 609 clauses=[#iclause{anno=LAnno, 610 pats=[#c_atom{anno=LA,val=true}], 611 guard=[], 612 body=Lps ++ [Lc]}, 613 #iclause{anno=LAnno, 614 pats=[#c_atom{anno=LA,val=false}], 615 guard=[], 616 body=Mps ++ [Mc]}], 617 fc=Fc}, 618 Fps,St4} 619 end 620 end; 621lc_tq(Line, E, [], More, St) -> 622 expr({cons,Line,E,More}, St). 623 624lc_guard_tests([], St) -> {[],St}; 625lc_guard_tests(Gs0, St) -> 626 Gs = guard_tests(Gs0), 627 gexpr_top(Gs, St). 628 629%% is_guard_test(Expression) -> true | false. 630%% Test if a general expression is a guard test. Use erl_lint here 631%% as it now allows sys_pre_expand transformed source. 632 633is_guard_test(E) -> erl_lint:is_guard_test(E). 634 635%% novars(Expr, State) -> {Novars,[PreExpr],State}. 636%% Generate a novars expression, basically a call or a safe. At this 637%% level we do not need to do a deep check. 638 639novars(E0, St0) -> 640 {E1,Eps,St1} = expr(E0, St0), 641 {Se,Sps,St2} = force_novars(E1, St1), 642 {Se,Eps ++ Sps,St2}. 643 644force_novars(#iapply{}=App, St) -> {App,[],St}; 645force_novars(#icall{}=Call, St) -> {Call,[],St}; 646force_novars(#iprimop{}=Prim, St) -> {Prim,[],St}; 647force_novars(#ifun{}=Fun, St) -> {Fun,[],St}; %These are novars too 648force_novars(#ibinary{}=Bin, St) -> {Bin,[],St}; 649force_novars(Ce, St) -> 650 force_safe(Ce, St). 651 652%% safe(Expr, State) -> {Safe,[PreExpr],State}. 653%% Generate an internal safe expression. These are simples without 654%% binaries which can fail. At this level we do not need to do a 655%% deep check. Must do special things with matches here. 656 657safe(E0, St0) -> 658 {E1,Eps,St1} = expr(E0, St0), 659 {Se,Sps,St2} = force_safe(E1, St1), 660 {Se,Eps ++ Sps,St2}. 661 662safe_list(Es, St) -> 663 foldr(fun (E, {Ces,Esp,St0}) -> 664 {Ce,Ep,St1} = safe(E, St0), 665 {[Ce|Ces],Ep ++ Esp,St1} 666 end, {[],[],St}, Es). 667 668force_safe(#imatch{anno=Anno,pat=P,arg=E,fc=Fc}, St0) -> 669 {Le,Lps,St1} = force_safe(E, St0), 670 {Le,Lps ++ [#imatch{anno=Anno,pat=P,arg=Le,fc=Fc}],St1}; 671force_safe(Ce, St0) -> 672 case is_safe(Ce) of 673 true -> {Ce,[],St0}; 674 false -> 675 {V,St1} = new_var(St0), 676 {V,[#iset{var=V,arg=Ce}],St1} 677 end. 678 679is_safe(#c_cons{}) -> true; 680is_safe(#c_tuple{}) -> true; 681is_safe(#c_var{}) -> true; 682is_safe(E) -> core_lib:is_atomic(E). 683 684%%% %% variable(Expr, State) -> {Variable,[PreExpr],State}. 685%%% %% force_variable(Expr, State) -> {Variable,[PreExpr],State}. 686%%% %% Generate a variable. 687 688%%% variable(E0, St0) -> 689%%% {E1,Eps,St1} = expr(E0, St0), 690%%% {V,Vps,St2} = force_variable(E1, St1), 691%%% {V,Eps ++ Vps,St2}. 692 693%%% force_variable(#c_var{}=Var, St) -> {Var,[],St}; 694%%% force_variable(Ce, St0) -> 695%%% {V,St1} = new_var(St0), 696%%% {V,[#iset{var=V,arg=Ce}],St1}. 697 698%%% %% atomic(Expr, State) -> {Atomic,[PreExpr],State}. 699%%% %% force_atomic(Expr, State) -> {Atomic,[PreExpr],State}. 700 701%%% atomic(E0, St0) -> 702%%% {E1,Eps,St1} = expr(E0, St0), 703%%% {A,Aps,St2} = force_atomic(E1, St1), 704%%% {A,Eps ++ Aps,St2}. 705 706%%% force_atomic(Ce, St0) -> 707%%% case core_lib:is_atomic(Ce) of 708%%% true -> {Ce,[],St0}; 709%%% false -> 710%%% {V,St1} = new_var(St0), 711%%% {V,[#iset{var=V,arg=Ce}],St1} 712%%% end. 713 714%% fold_match(MatchExpr, Pat) -> {MatchPat,Expr}. 715%% Fold nested matches into one match with aliased patterns. 716 717fold_match({match,L,P0,E0}, P) -> 718 {P1,E1} = fold_match(E0, P), 719 {{match,L,P0,P1},E1}; 720fold_match(E, P) -> {P,E}. 721 722%% pattern(Pattern) -> CorePat. 723%% Transform a pattern by removing line numbers. We also normalise 724%% aliases in patterns to standard form, {alias,Pat,[Var]}. 725 726pattern({var,L,V}) -> #c_var{anno=[L],name=V}; 727pattern({char,L,C}) -> #c_char{anno=[L],val=C}; 728pattern({integer,L,I}) -> #c_int{anno=[L],val=I}; 729pattern({float,L,F}) -> #c_float{anno=[L],val=F}; 730pattern({atom,L,A}) -> #c_atom{anno=[L],val=A}; 731pattern({string,L,S}) -> #c_string{anno=[L],val=S}; 732pattern({nil,L}) -> #c_nil{anno=[L]}; 733pattern({cons,L,H,T}) -> 734 #c_cons{anno=[L],hd=pattern(H),tl=pattern(T)}; 735pattern({tuple,L,Ps}) -> 736 #c_tuple{anno=[L],es=pattern_list(Ps)}; 737pattern({bin,L,Ps}) -> 738 %% We don't create a #ibinary record here, since there is 739 %% no need to hold any used/new annoations in a pattern. 740 #c_binary{anno=[L],segments=pat_bin(Ps)}; 741pattern({match,_,P1,P2}) -> 742 pat_alias(pattern(P1), pattern(P2)). 743 744%% bin_pattern_list([BinElement]) -> [BinSeg]. 745 746pat_bin(Ps) -> map(fun pat_segment/1, Ps). 747 748pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}) -> 749 #c_bitstr{val=pattern(Term),size=pattern(Size), 750 unit=core_lib:make_literal(Unit), 751 type=core_lib:make_literal(Type), 752 flags=core_lib:make_literal(Flags)}. 753 754%% pat_alias(CorePat, CorePat) -> AliasPat. 755%% Normalise aliases. Trap bad aliases by throwing 'nomatch'. 756 757pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; 758pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; 759pat_alias(#c_cons{}=Cons, #c_string{anno=A,val=[H|T]}=S) -> 760 pat_alias(Cons, #c_cons{anno=A,hd=#c_char{anno=A,val=H}, 761 tl=S#c_string{val=T}}); 762pat_alias(#c_string{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> 763 pat_alias(#c_cons{anno=A,hd=#c_char{anno=A,val=H}, 764 tl=S#c_string{val=T}}, Cons); 765pat_alias(#c_nil{}=Nil, #c_string{val=[]}) -> 766 Nil; 767pat_alias(#c_string{val=[]}, #c_nil{}=Nil) -> 768 Nil; 769pat_alias(#c_cons{anno=A,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> 770 #c_cons{anno=A,hd=pat_alias(H1, H2),tl=pat_alias(T1, T2)}; 771pat_alias(#c_tuple{es=Es1}, #c_tuple{es=Es2}) -> 772 #c_tuple{es=pat_alias_list(Es1, Es2)}; 773pat_alias(#c_char{val=C}=Char, #c_int{val=C}) -> 774 Char; 775pat_alias(#c_int{val=C}, #c_char{val=C}=Char) -> 776 Char; 777pat_alias(#c_alias{var=V1,pat=P1}, 778 #c_alias{var=V2,pat=P2}) -> 779 if V1 == V2 -> pat_alias(P1, P2); 780 true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}} 781 end; 782pat_alias(#c_alias{var=V1,pat=P1}, P2) -> 783 #c_alias{var=V1,pat=pat_alias(P1, P2)}; 784pat_alias(P1, #c_alias{var=V2,pat=P2}) -> 785 #c_alias{var=V2,pat=pat_alias(P1, P2)}; 786pat_alias(P, P) -> P; 787pat_alias(_, _) -> throw(nomatch). 788 789%% pat_alias_list([A1], [A2]) -> [A]. 790 791pat_alias_list([A1|A1s], [A2|A2s]) -> 792 [pat_alias(A1, A2)|pat_alias_list(A1s, A2s)]; 793pat_alias_list([], []) -> []; 794pat_alias_list(_, _) -> throw(nomatch). 795 796%% pattern_list([P]) -> [P]. 797 798pattern_list(Ps) -> map(fun pattern/1, Ps). 799 800%% first([A]) -> [A]. 801%% last([A]) -> A. 802 803first([_]) -> []; 804first([H|T]) -> [H|first(T)]. 805 806last([L]) -> L; 807last([_|T]) -> last(T). 808 809%% make_vars([Name]) -> [{Var,Name}]. 810 811make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ]. 812 813%% new_fun_name(Type, State) -> {FunName,State}. 814 815new_fun_name(Type, #core{fcount=C}=St) -> 816 {list_to_atom(Type ++ "$^" ++ integer_to_list(C)),St#core{fcount=C+1}}. 817 818%% new_var_name(State) -> {VarName,State}. 819 820new_var_name(#core{vcount=C}=St) -> 821 {list_to_atom("cor" ++ integer_to_list(C)),St#core{vcount=C + 1}}. 822 823%% new_var(State) -> {{var,Name},State}. 824%% new_var(LineAnno, State) -> {{var,Name},State}. 825 826new_var(St) -> 827 new_var([], St). 828 829new_var(Anno, St0) -> 830 {New,St} = new_var_name(St0), 831 {#c_var{anno=Anno,name=New},St}. 832 833%% new_vars(Count, State) -> {[Var],State}. 834%% new_vars(Anno, Count, State) -> {[Var],State}. 835%% Make Count new variables. 836 837new_vars(N, St) -> new_vars_1(N, [], St, []). 838new_vars(Anno, N, St) -> new_vars_1(N, Anno, St, []). 839 840new_vars_1(N, Anno, St0, Vs) when N > 0 -> 841 {V,St1} = new_var(Anno, St0), 842 new_vars_1(N-1, Anno, St1, [V|Vs]); 843new_vars_1(0, _, St, Vs) -> {Vs,St}. 844 845fail_clause(Pats, A) -> 846 #iclause{anno=#a{anno=[compiler_generated]}, 847 pats=Pats,guard=[], 848 body=[#iprimop{anno=#a{},name=#c_atom{val=match_fail},args=[A]}]}. 849 850ubody(B, St) -> uexpr(B, [], St). 851 852%% uclauses([Lclause], [KnownVar], State) -> {[Lclause],State}. 853 854uclauses(Lcs, Ks, St0) -> 855 mapfoldl(fun (Lc, St) -> uclause(Lc, Ks, St) end, St0, Lcs). 856 857%% uclause(Lclause, [KnownVar], State) -> {Lclause,State}. 858 859uclause(Cl0, Ks, St0) -> 860 {Cl1,_Pvs,Used,New,St1} = uclause(Cl0, Ks, Ks, St0), 861 A0 = get_ianno(Cl1), 862 A = A0#a{us=Used,ns=New}, 863 {Cl1#iclause{anno=A},St1}. 864 865uclause(#iclause{anno=Anno,pats=Ps0,guard=G0,body=B0}, Pks, Ks0, St0) -> 866 {Ps1,Pg,Pvs,Pus,St1} = upattern_list(Ps0, Pks, St0), 867 Pu = union(Pus, intersection(Pvs, Ks0)), 868 Pn = subtract(Pvs, Pu), 869 Ks1 = union(Pn, Ks0), 870 {G1,St2} = uguard(Pg, G0, Ks1, St1), 871 Gu = used_in_any(G1), 872 Gn = new_in_any(G1), 873 Ks2 = union(Gn, Ks1), 874 {B1,St3} = uexprs(B0, Ks2, St2), 875 Used = intersection(union([Pu,Gu,used_in_any(B1)]), Ks0), 876 New = union([Pn,Gn,new_in_any(B1)]), 877 {#iclause{anno=Anno,pats=Ps1,guard=G1,body=B1},Pvs,Used,New,St3}. 878 879%% uguard([Test], [Kexpr], [KnownVar], State) -> {[Kexpr],State}. 880%% Build a guard expression list by folding in the equality tests. 881 882uguard([], [], _, St) -> {[],St}; 883uguard(Pg, [], Ks, St) -> 884 %% No guard, so fold together equality tests. 885 uguard(first(Pg), [last(Pg)], Ks, St); 886uguard(Pg, Gs0, Ks, St0) -> 887 %% Gs0 must contain at least one element here. 888 {Gs3,St5} = foldr(fun (T, {Gs1,St1}) -> 889 {L,St2} = new_var(St1), 890 {R,St3} = new_var(St2), 891 {[#iset{var=L,arg=T}] ++ first(Gs1) ++ 892 [#iset{var=R,arg=last(Gs1)}, 893 #icall{anno=#a{}, %Must have an #a{} 894 module=#c_atom{val=erlang}, 895 name=#c_atom{val='and'}, 896 args=[L,R]}], 897 St3} 898 end, {Gs0,St0}, Pg), 899 %%ok = io:fwrite("core ~w: ~p~n", [?LINE,Gs3]), 900 uexprs(Gs3, Ks, St5). 901 902%% uexprs([Kexpr], [KnownVar], State) -> {[Kexpr],State}. 903 904uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) -> 905 %% Optimise for simple set of unbound variable. 906 case upattern(P0, Ks, St0) of 907 {#c_var{},[],_Pvs,_Pus,_} -> 908 %% Throw our work away and just set to iset. 909 uexprs([#iset{var=P0,arg=Arg}|Les], Ks, St0); 910 _Other -> 911 %% Throw our work away and set to icase. 912 if 913 Les == [] -> 914 %% Need to explicitly return match "value", make 915 %% safe for efficiency. 916 {La,Lps,St1} = force_safe(Arg, St0), 917 Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]}, 918 uexprs(Lps ++ [#icase{anno=A, 919 args=[La],clauses=[Mc],fc=Fc}], Ks, St1); 920 true -> 921 Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les}, 922 uexprs([#icase{anno=A,args=[Arg], 923 clauses=[Mc],fc=Fc}], Ks, St0) 924 end 925 end; 926uexprs([Le0|Les0], Ks, St0) -> 927 {Le1,St1} = uexpr(Le0, Ks, St0), 928 {Les1,St2} = uexprs(Les0, union((core_lib:get_anno(Le1))#a.ns, Ks), St1), 929 {[Le1|Les1],St2}; 930uexprs([], _, St) -> {[],St}. 931 932uexpr(#iset{anno=A,var=V,arg=A0}, Ks, St0) -> 933 {A1,St1} = uexpr(A0, Ks, St0), 934 {#iset{anno=A#a{us=del_element(V#c_var.name, (core_lib:get_anno(A1))#a.us), 935 ns=add_element(V#c_var.name, (core_lib:get_anno(A1))#a.ns)}, 936 var=V,arg=A1},St1}; 937%% imatch done in uexprs. 938uexpr(#iletrec{anno=A,defs=Fs0,body=B0}, Ks, St0) -> 939 %%ok = io:fwrite("~w: ~p~n", [?LINE,{Fs0,B0}]), 940 {Fs1,St1} = mapfoldl(fun ({Name,F0}, St0) -> 941 {F1,St1} = uexpr(F0, Ks, St0), 942 {{Name,F1},St1} 943 end, St0, Fs0), 944 {B1,St2} = uexprs(B0, Ks, St1), 945 Used = used_in_any(map(fun ({_,F}) -> F end, Fs1) ++ B1), 946 {#iletrec{anno=A#a{us=Used,ns=[]},defs=Fs1,body=B1},St2}; 947uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> 948 %% As0 will never generate new variables. 949 {As1,St1} = uexpr_list(As0, Ks, St0), 950 {Cs1,St2} = uclauses(Cs0, Ks, St1), 951 {Fc1,St3} = uclause(Fc0, Ks, St2), 952 Used = union(used_in_any(As1), used_in_any(Cs1)), 953 New = new_in_all(Cs1), 954 {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; 955uexpr(#ifun{anno=A,id=Id,vars=As,clauses=Cs0,fc=Fc0}, Ks0, St0) -> 956 Avs = lit_list_vars(As), 957 Ks1 = union(Avs, Ks0), 958 {Cs1,St1} = ufun_clauses(Cs0, Ks1, St0), 959 {Fc1,St2} = ufun_clause(Fc0, Ks1, St1), 960 Used = subtract(intersection(used_in_any(Cs1), Ks0), Avs), 961 {#ifun{anno=A#a{us=Used,ns=[]},id=Id,vars=As,clauses=Cs1,fc=Fc1},St2}; 962uexpr(#iapply{anno=A,op=Op,args=As}, _, St) -> 963 Used = union(lit_vars(Op), lit_list_vars(As)), 964 {#iapply{anno=A#a{us=Used},op=Op,args=As},St}; 965uexpr(#iprimop{anno=A,name=Name,args=As}, _, St) -> 966 Used = lit_list_vars(As), 967 {#iprimop{anno=A#a{us=Used},name=Name,args=As},St}; 968uexpr(#icall{anno=A,module=Mod,name=Name,args=As}, _, St) -> 969 Used = union([lit_vars(Mod),lit_vars(Name),lit_list_vars(As)]), 970 {#icall{anno=A#a{us=Used},module=Mod,name=Name,args=As},St}; 971uexpr(#itry{anno=A,args=As0,vars=Vs,body=Bs0,evars=Evs,handler=Hs0}, Ks, St0) -> 972 %% Note that we export only from body and exception. 973 {As1,St1} = uexprs(As0, Ks, St0), 974 {Bs1,St2} = uexprs(Bs0, Ks, St1), 975 {Hs1,St3} = uexprs(Hs0, Ks, St2), 976 Used = intersection(used_in_any(Bs1++Hs1++As1), Ks), 977 New = new_in_all(Bs1++Hs1), 978 {#itry{anno=A#a{us=Used,ns=New}, 979 args=As1,vars=Vs,body=Bs1,evars=Evs,handler=Hs1},St3}; 980uexpr(#icatch{anno=A,body=Es0}, Ks, St0) -> 981 {Es1,St1} = uexprs(Es0, Ks, St0), 982 {#icatch{anno=A#a{us=used_in_any(Es1)},body=Es1},St1}; 983uexpr(#ireceive1{anno=A,clauses=Cs0}, Ks, St0) -> 984 {Cs1,St1} = uclauses(Cs0, Ks, St0), 985 {#ireceive1{anno=A#a{us=used_in_any(Cs1),ns=new_in_all(Cs1)}, 986 clauses=Cs1},St1}; 987uexpr(#ireceive2{anno=A,clauses=Cs0,timeout=Te0,action=Tes0}, Ks, St0) -> 988 %% Te0 will never generate new variables. 989 {Te1,St1} = uexpr(Te0, Ks, St0), 990 {Cs1,St2} = uclauses(Cs0, Ks, St1), 991 {Tes1,St3} = uexprs(Tes0, Ks, St2), 992 Used = union([used_in_any(Cs1),used_in_any(Tes1), 993 (core_lib:get_anno(Te1))#a.us]), 994 New = case Cs1 of 995 [] -> new_in_any(Tes1); 996 _ -> intersection(new_in_all(Cs1), new_in_any(Tes1)) 997 end, 998 {#ireceive2{anno=A#a{us=Used,ns=New}, 999 clauses=Cs1,timeout=Te1,action=Tes1},St3}; 1000uexpr(#iprotect{anno=A,body=Es0}, Ks, St0) -> 1001 {Es1,St1} = uexprs(Es0, Ks, St0), 1002 Used = used_in_any(Es1), 1003 {#iprotect{anno=A#a{us=Used},body=Es1},St1}; %No new variables escape! 1004uexpr(#ibinary{anno=A,segments=Ss}, _, St) -> 1005 Used = bitstr_vars(Ss), 1006 {#ibinary{anno=A#a{us=Used},segments=Ss},St}; 1007uexpr(Lit, _, St) -> 1008 true = core_lib:is_simple(Lit), %Sanity check! 1009 Vs = lit_vars(Lit), 1010 Anno = core_lib:get_anno(Lit), 1011 {core_lib:set_anno(Lit, #a{us=Vs,anno=Anno}),St}. 1012 1013uexpr_list(Les0, Ks, St0) -> 1014 mapfoldl(fun (Le, St) -> uexpr(Le, Ks, St) end, St0, Les0). 1015 1016%% ufun_clauses([Lclause], [KnownVar], State) -> {[Lclause],State}. 1017 1018ufun_clauses(Lcs, Ks, St0) -> 1019 mapfoldl(fun (Lc, St) -> ufun_clause(Lc, Ks, St) end, St0, Lcs). 1020 1021%% ufun_clause(Lclause, [KnownVar], State) -> {Lclause,State}. 1022 1023ufun_clause(Cl0, Ks, St0) -> 1024 {Cl1,Pvs,Used,_,St1} = uclause(Cl0, [], Ks, St0), 1025 A0 = get_ianno(Cl1), 1026 A = A0#a{us=subtract(intersection(Used, Ks), Pvs),ns=[]}, 1027 {Cl1#iclause{anno=A},St1}. 1028 1029%% upattern(Pat, [KnownVar], State) -> 1030%% {Pat,[GuardTest],[NewVar],[UsedVar],State}. 1031 1032upattern(#c_var{name='_'}, _, St0) -> 1033 {New,St1} = new_var_name(St0), 1034 {#c_var{name=New},[],[New],[],St1}; 1035upattern(#c_var{name=V}=Var, Ks, St0) -> 1036 case is_element(V, Ks) of 1037 true -> 1038 {N,St1} = new_var_name(St0), 1039 New = #c_var{name=N}, 1040 Test = #icall{anno=#a{us=add_element(N, [V])}, 1041 module=#c_atom{val=erlang}, 1042 name=#c_atom{val='=:='}, 1043 args=[New,Var]}, 1044 %% Test doesn't need protecting. 1045 {New,[Test],[N],[],St1}; 1046 false -> {Var,[],[V],[],St0} 1047 end; 1048upattern(#c_cons{hd=H0,tl=T0}=Cons, Ks, St0) -> 1049 {H1,Hg,Hv,Hu,St1} = upattern(H0, Ks, St0), 1050 {T1,Tg,Tv,Tu,St2} = upattern(T0, union(Hv, Ks), St1), 1051 {Cons#c_cons{hd=H1,tl=T1},Hg ++ Tg,union(Hv, Tv),union(Hu, Tu),St2}; 1052upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) -> 1053 {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), 1054 {Tuple#c_tuple{es=Es1},Esg,Esv,Eus,St1}; 1055upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> 1056 {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), 1057 {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; 1058upattern(#c_alias{var=V0,pat=P0}=Alias, Ks, St0) -> 1059 {V1,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), 1060 {P1,Pg,Pv,Pu,St2} = upattern(P0, union(Vv, Ks), St1), 1061 {Alias#c_alias{var=V1,pat=P1},Vg ++ Pg,union(Vv, Pv),union(Vu, Pu),St2}; 1062upattern(Other, _, St) -> {Other,[],[],[],St}. %Constants 1063 1064%% upattern_list([Pat], [KnownVar], State) -> 1065%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. 1066 1067upattern_list([P0|Ps0], Ks, St0) -> 1068 {P1,Pg,Pv,Pu,St1} = upattern(P0, Ks, St0), 1069 {Ps1,Psg,Psv,Psu,St2} = upattern_list(Ps0, union(Pv, Ks), St1), 1070 {[P1|Ps1],Pg ++ Psg,union(Pv, Psv),union(Pu, Psu),St2}; 1071upattern_list([], _, St) -> {[],[],[],[],St}. 1072 1073%% upat_bin([Pat], [KnownVar], State) -> 1074%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. 1075upat_bin(Es0, Ks, St0) -> 1076 upat_bin(Es0, Ks, [], St0). 1077 1078%% upat_bin([Pat], [KnownVar], [LocalVar], State) -> 1079%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. 1080upat_bin([P0|Ps0], Ks, Bs, St0) -> 1081 {P1,Pg,Pv,Pu,Bs1,St1} = upat_element(P0, Ks, Bs, St0), 1082 {Ps1,Psg,Psv,Psu,St2} = upat_bin(Ps0, union(Pv, Ks), Bs1, St1), 1083 {[P1|Ps1],Pg ++ Psg,union(Pv, Psv),union(Pu, Psu),St2}; 1084upat_bin([], _, _, St) -> {[],[],[],[],St}. 1085 1086 1087%% upat_element(Segment, [KnownVar], [LocalVar], State) -> 1088%% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State} 1089upat_element(#c_bitstr{val=H0,size=Sz}=Seg, Ks, Bs, St0) -> 1090 {H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0), 1091 Bs1 = case H0 of 1092 #c_var{name=Hname} -> 1093 case H1 of 1094 #c_var{name=Hname} -> 1095 Bs; 1096 #c_var{name=Other} -> 1097 [{Hname, Other}|Bs] 1098 end; 1099 _ -> 1100 Bs 1101 end, 1102 {Sz1, Us} = case Sz of 1103 #c_var{name=Vname} -> 1104 rename_bitstr_size(Vname, Bs); 1105 _Other -> {Sz, []} 1106 end, 1107 {Seg#c_bitstr{val=H1, size=Sz1},Hg,Hv,Us,Bs1,St1}. 1108 1109rename_bitstr_size(V, [{V, N}|_]) -> 1110 New = #c_var{name=N}, 1111 {New, [N]}; 1112rename_bitstr_size(V, [_|Rest]) -> 1113 rename_bitstr_size(V, Rest); 1114rename_bitstr_size(V, []) -> 1115 Old = #c_var{name=V}, 1116 {Old, [V]}. 1117 1118used_in_any(Les) -> 1119 foldl(fun (Le, Ns) -> union((core_lib:get_anno(Le))#a.us, Ns) end, 1120 [], Les). 1121 1122new_in_any(Les) -> 1123 foldl(fun (Le, Ns) -> union((core_lib:get_anno(Le))#a.ns, Ns) end, 1124 [], Les). 1125 1126new_in_all([Le|Les]) -> 1127 foldl(fun (L, Ns) -> intersection((core_lib:get_anno(L))#a.ns, Ns) end, 1128 (core_lib:get_anno(Le))#a.ns, Les); 1129new_in_all([]) -> []. 1130 1131%% The AfterVars are the variables which are used afterwards. We need 1132%% this to work out which variables are actually exported and used 1133%% from case/receive. In subblocks/clauses the AfterVars of the block 1134%% are just the exported variables. 1135 1136cbody(B0, St0) -> 1137 {B1,_,_,St1} = cexpr(B0, [], St0), 1138 {B1,St1}. 1139 1140%% cclause(Lclause, [AfterVar], State) -> {Cclause,State}. 1141%% The AfterVars are the exported variables. 1142 1143cclause(#iclause{anno=#a{anno=Anno},pats=Ps,guard=G0,body=B0}, Exp, St0) -> 1144 {B1,_Us1,St1} = cexprs(B0, Exp, St0), 1145 {G1,St2} = cguard(G0, St1), 1146 {#c_clause{anno=Anno,pats=Ps,guard=G1,body=B1},St2}. 1147 1148cclauses(Lcs, Es, St0) -> 1149 mapfoldl(fun (Lc, St) -> cclause(Lc, Es, St) end, St0, Lcs). 1150 1151cguard([], St) -> {#c_atom{val=true},St}; 1152cguard(Gs, St0) -> 1153 {G,_,St1} = cexprs(Gs, [], St0), 1154 {G,St1}. 1155 1156%% cexprs([Lexpr], [AfterVar], State) -> {Cexpr,[AfterVar],State}. 1157%% Must be sneaky here at the last expr when combining exports for the 1158%% whole sequence and exports for that expr. 1159 1160cexprs([#iset{var=#c_var{name=Name}=Var}=Iset], As, St) -> 1161 %% Make return value explicit, and make Var true top level. 1162 cexprs([Iset,Var#c_var{anno=#a{us=[Name]}}], As, St); 1163cexprs([Le], As, St0) -> 1164 {Ce,Es,Us,St1} = cexpr(Le, As, St0), 1165 Exp = make_vars(As), %The export variables 1166 if 1167 Es == [] -> {core_lib:make_values([Ce|Exp]),union(Us, As),St1}; 1168 true -> 1169 {R,St2} = new_var(St1), 1170 {#c_let{anno=get_lineno_anno(Ce), 1171 vars=[R|make_vars(Es)],arg=Ce, 1172 body=core_lib:make_values([R|Exp])}, 1173 union(Us, As),St2} 1174 end; 1175cexprs([#iset{anno=#a{anno=A},var=V,arg=A0}|Les], As0, St0) -> 1176 {Ces,As1,St1} = cexprs(Les, As0, St0), 1177 {A1,Es,Us,St2} = cexpr(A0, As1, St1), 1178 {#c_let{anno=A,vars=[V|make_vars(Es)],arg=A1,body=Ces}, 1179 union(Us, As1),St2}; 1180cexprs([Le|Les], As0, St0) -> 1181 {Ces,As1,St1} = cexprs(Les, As0, St0), 1182 {Ce,Es,Us,St2} = cexpr(Le, As1, St1), 1183 if 1184 Es == [] -> 1185 {#c_seq{arg=Ce,body=Ces},union(Us, As1),St2}; 1186 true -> 1187 {R,St3} = new_var(St2), 1188 {#c_let{vars=[R|make_vars(Es)],arg=Ce,body=Ces}, 1189 union(Us, As1),St3} 1190 end. 1191 1192%% cexpr(Lexpr, [AfterVar], State) -> {Cexpr,[ExpVar],[UsedVar],State}. 1193 1194cexpr(#iletrec{anno=A,defs=Fs0,body=B0}, As, St0) -> 1195 {Fs1,{_,St1}} = mapfoldl(fun ({Name,F0}, {Used,St0}) -> 1196 {F1,[],Us,St1} = cexpr(F0, [], St0), 1197 {#c_def{name=#c_fname{id=Name,arity=1}, 1198 val=F1}, 1199 {union(Us, Used),St1}} 1200 end, {[],St0}, Fs0), 1201 Exp = intersection(A#a.ns, As), 1202 {B1,_Us,St2} = cexprs(B0, Exp, St1), 1203 {#c_letrec{anno=A#a.anno,defs=Fs1,body=B1},Exp,A#a.us,St2}; 1204cexpr(#icase{anno=A,args=Largs,clauses=Lcs,fc=Lfc}, As, St0) -> 1205 Exp = intersection(A#a.ns, As), %Exports 1206 {Cargs,St1} = foldr(fun (La, {Cas,Sta}) -> 1207 {Ca,[],_Us1,Stb} = cexpr(La, As, Sta), 1208 {[Ca|Cas],Stb} 1209 end, {[],St0}, Largs), 1210 {Ccs,St2} = cclauses(Lcs, Exp, St1), 1211 {Cfc,St3} = cclause(Lfc, [], St2), %Never exports 1212 {#c_case{anno=A#a.anno, 1213 arg=core_lib:make_values(Cargs),clauses=Ccs ++ [Cfc]}, 1214 Exp,A#a.us,St3}; 1215cexpr(#ireceive1{anno=A,clauses=Lcs}, As, St0) -> 1216 Exp = intersection(A#a.ns, As), %Exports 1217 {Ccs,St1} = cclauses(Lcs, Exp, St0), 1218 {#c_receive{anno=A#a.anno, 1219 clauses=Ccs, 1220 timeout=#c_atom{val=infinity},action=#c_atom{val=true}}, 1221 Exp,A#a.us,St1}; 1222cexpr(#ireceive2{anno=A,clauses=Lcs,timeout=Lto,action=Les}, As, St0) -> 1223 Exp = intersection(A#a.ns, As), %Exports 1224 {Cto,[],_Us1,St1} = cexpr(Lto, As, St0), 1225 {Ccs,St2} = cclauses(Lcs, Exp, St1), 1226 {Ces,_Us2,St3} = cexprs(Les, Exp, St2), 1227 {#c_receive{anno=A#a.anno, 1228 clauses=Ccs,timeout=Cto,action=Ces}, 1229 Exp,A#a.us,St3}; 1230cexpr(#itry{anno=A,args=La,vars=Vs,body=Lb,evars=Evs,handler=Lh}, As, St0) -> 1231 Exp = intersection(A#a.ns, As), %Exports 1232 {Ca,_Us1,St1} = cexprs(La, [], St0), 1233 {Cb,_Us2,St2} = cexprs(Lb, Exp, St1), 1234 {Ch,_Us3,St3} = cexprs(Lh, Exp, St2), 1235 {#c_try{anno=A#a.anno,arg=Ca,vars=Vs,body=Cb,evars=Evs,handler=Ch}, 1236 Exp,A#a.us,St3}; 1237cexpr(#icatch{anno=A,body=Les}, _As, St0) -> 1238 {Ces,_Us1,St1} = cexprs(Les, [], St0), %Never export! 1239 {#c_catch{body=Ces},[],A#a.us,St1}; 1240cexpr(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> 1241 {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! 1242 {Cfc,St2} = cclause(Lfc, [], St1), 1243 Anno = A#a.anno, 1244 {#c_fun{anno=Id++Anno,vars=Args, 1245 body=#c_case{anno=Anno, 1246 arg=core_lib:set_anno(core_lib:make_values(Args), Anno), 1247 clauses=Ccs ++ [Cfc]}}, 1248 [],A#a.us,St2}; 1249cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) -> 1250 {#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St}; 1251cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) -> 1252 {#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St}; 1253cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) -> 1254 {#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St}; 1255cexpr(#iprotect{anno=A,body=Es}, _As, St0) -> 1256 {Ce,_,St1} = cexprs(Es, [], St0), 1257 V = #c_var{name='Try'}, %The names are arbitrary 1258 Vs = [#c_var{name='T'},#c_var{name='R'}], 1259 {#c_try{anno=A#a.anno,arg=Ce,vars=[V],body=V, 1260 evars=Vs,handler=#c_atom{val=false}}, 1261 [],A#a.us,St1}; 1262cexpr(#ibinary{anno=#a{anno=Anno,us=Us},segments=Segs}, _As, St) -> 1263 {#c_binary{anno=Anno,segments=Segs},[],Us,St}; 1264cexpr(Lit, _As, St) -> 1265 true = core_lib:is_simple(Lit), %Sanity check! 1266 Anno = core_lib:get_anno(Lit), 1267 Vs = Anno#a.us, 1268 %%Vs = lit_vars(Lit), 1269 {core_lib:set_anno(Lit, Anno#a.anno),[],Vs,St}. 1270 1271%% lit_vars(Literal) -> [Var]. 1272 1273lit_vars(Lit) -> lit_vars(Lit, []). 1274 1275lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs)); 1276lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs); 1277lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs); 1278lit_vars(_, Vs) -> Vs. %These are atomic 1279 1280% lit_bin_vars(Segs, Vs) -> 1281% foldl(fun (#c_bitstr{val=V,size=S}, Vs0) -> 1282% lit_vars(V, lit_vars(S, Vs0)) 1283% end, Vs, Segs). 1284 1285lit_list_vars(Ls) -> lit_list_vars(Ls, []). 1286 1287lit_list_vars(Ls, Vs) -> 1288 foldl(fun (L, Vs0) -> lit_vars(L, Vs0) end, Vs, Ls). 1289 1290bitstr_vars(Segs) -> 1291 bitstr_vars(Segs, []). 1292 1293bitstr_vars(Segs, Vs) -> 1294 foldl(fun (#c_bitstr{val=V,size=S}, Vs0) -> 1295 lit_vars(V, lit_vars(S, Vs0)) 1296 end, Vs, Segs). 1297 1298get_ianno(Ce) -> 1299 case core_lib:get_anno(Ce) of 1300 #a{}=A -> A; 1301 A when is_list(A) -> #a{anno=A} 1302 end. 1303 1304get_lineno_anno(Ce) -> 1305 case core_lib:get_anno(Ce) of 1306 #a{anno=A} -> A; 1307 A when is_list(A) -> A 1308 end. 1309 1310 1311%%% 1312%%% Handling of warnings. 1313%%% 1314 1315format_error(nomatch) -> "pattern cannot possibly match". 1316 1317add_warning(Line, Term, #core{ws=Ws}=St) when Line >= 0 -> 1318 St#core{ws=[{Line,?MODULE,Term}|Ws]}; 1319add_warning(_, _, St) -> St. 1320