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_kernel.erl,v 1.3 2010/03/04 13:54:20 maria Exp $ 18%% 19%% Purpose : Transform Core Erlang to Kernel Erlang 20 21%% Kernel erlang is like Core Erlang with a few significant 22%% differences: 23%% 24%% 1. It is flat! There are no nested calls or sub-blocks. 25%% 26%% 2. All variables are unique in a function. There is no scoping, or 27%% rather the scope is the whole function. 28%% 29%% 3. Pattern matching (in cases and receives) has been compiled. 30%% 31%% 4. The annotations contain variable usages. Seeing we have to work 32%% this out anyway for funs we might as well pass it on for free to 33%% later passes. 34%% 35%% 5. All remote-calls are to statically named m:f/a. Meta-calls are 36%% passed via erlang:apply/3. 37%% 38%% The translation is done in two passes: 39%% 40%% 1. Basic translation, translate variable/function names, flatten 41%% completely, pattern matching compilation. 42%% 43%% 2. Fun-lifting (lambda-lifting), variable usage annotation and 44%% last-call handling. 45%% 46%% All new Kexprs are created in the first pass, they are just 47%% annotated in the second. 48%% 49%% Functions and BIFs 50%% 51%% Functions are "call"ed or "enter"ed if it is a last call, their 52%% return values may be ignored. BIFs are things which are known to 53%% be internal by the compiler and can only be called, their return 54%% values cannot be ignored. 55%% 56%% Letrec's are handled rather naively. All the functions in one 57%% letrec are handled as one block to find the free variables. While 58%% this is not optimal it reflects how letrec's often are used. We 59%% don't have to worry about variable shadowing and nested letrec's as 60%% this is handled in the variable/function name translation. There 61%% is a little bit of trickery to ensure letrec transformations fit 62%% into the scheme of things. 63%% 64%% To ensure unique variable names we use a variable substitution 65%% table and keep the set of all defined variables. The nested 66%% scoping of Core means that we must also nest the substitution 67%% tables, but the defined set must be passed through to match the 68%% flat structure of Kernel and to make sure variables with the same 69%% name from different scopes get different substitutions. 70%% 71%% We also use these substitutions to handle the variable renaming 72%% necessary in pattern matching compilation. 73%% 74%% The pattern matching compilation assumes that the values of 75%% different types don't overlap. This means that as there is no 76%% character type yet in the machine all characters must be converted 77%% to integers! 78 79-module(v3_kernel). 80 81-export([module/2,format_error/1]). 82 83-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2, 84 member/2,reverse/1,reverse/2]). 85-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). 86 87-include("core_parse.hrl"). 88-include("v3_kernel.hrl"). 89 90%% These are not defined in v3_kernel.hrl. 91get_kanno(Kthing) -> element(2, Kthing). 92set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). 93 94%% Internal kernel expressions and help functions. 95%% N.B. the annotation field is ALWAYS the first field! 96 97-record(ivalues, {anno=[],args}). 98-record(ifun, {anno=[],vars,body}). 99-record(iset, {anno=[],vars,arg,body}). 100-record(iletrec, {anno=[],defs}). 101-record(ialias, {anno=[],vars,pat}). 102-record(iclause, {anno=[],sub,pats,guard,body}). 103-record(ireceive_accept, {anno=[],arg}). 104-record(ireceive_next, {anno=[],arg}). 105 106%% State record for kernel translator. 107-record(kern, {func, %Current function 108 vcount=0, %Variable counter 109 fcount=0, %Fun counter 110 ds=[], %Defined variables 111 funs=[], %Fun functions 112 free=[], %Free variables 113 ws=[], %Warnings. 114 extinstr=false}). %Generate extended instructions 115 116module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) -> 117 ExtInstr = not member(no_new_apply, Options), 118 {Kfs,St} = mapfoldl(fun function/2, #kern{extinstr=ExtInstr}, Fs), 119 Kes = map(fun (#c_fname{id=N,arity=Ar}) -> {N,Ar} end, Es), 120 Kas = map(fun (#c_def{name=#c_atom{val=N},val=V}) -> 121 {N,core_lib:literal_value(V)} end, As), 122 {ok,#k_mdef{anno=A,name=M#c_atom.val,exports=Kes,attributes=Kas, 123 body=Kfs ++ St#kern.funs},St#kern.ws}. 124 125function(#c_def{anno=Af,name=#c_fname{id=F,arity=Arity},val=Body}, St0) -> 126 %%ok = io:fwrite("kern: ~p~n", [{F,Arity}]), 127 St1 = St0#kern{func={F,Arity},vcount=0,fcount=0,ds=sets:new()}, 128 {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), 129 {B1,_,St3} = ubody(B0, return, St2), 130 %%B1 = B0, St3 = St2, %Null second pass 131 {#k_fdef{anno=#k{us=[],ns=[],a=Af ++ Ab}, 132 func=F,arity=Arity,vars=Kvs,body=B1},St3}. 133 134%% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. 135%% Do the main sequence of a body. A body ends in an atomic value or 136%% values. Must check if vector first so do expr. 137 138body(#c_values{anno=A,es=Ces}, Sub, St0) -> 139 %% Do this here even if only in bodies. 140 {Kes,Pe,St1} = atomic_list(Ces, Sub, St0), 141 %%{Kes,Pe,St1} = expr_list(Ces, Sub, St0), 142 {#ivalues{anno=A,args=Kes},Pe,St1}; 143body(#ireceive_next{anno=A}, _, St) -> 144 {#k_receive_next{anno=A},[],St}; 145body(Ce, Sub, St0) -> 146 expr(Ce, Sub, St0). 147 148%% guard(Cexpr, Sub, State) -> {Kexpr,State}. 149%% We handle guards almost as bodies. The only special thing we 150%% must do is to make the final Kexpr a #k_test{}. 151%% Also, we wrap the entire guard in a try/catch which is 152%% not strictly needed, but makes sure that every 'bif' instruction 153%% will get a proper failure label. 154 155guard(G0, Sub, St0) -> 156 {G1,St1} = wrap_guard(G0, St0), 157 {Ge0,Pre,St2} = expr(G1, Sub, St1), 158 {Ge,St} = gexpr_test(Ge0, St2), 159 {pre_seq(Pre, Ge),St}. 160 161%% Wrap the entire guard in a try/catch if needed. 162 163wrap_guard(#c_try{}=Try, St) -> {Try,St}; 164wrap_guard(Core, St0) -> 165 {VarName,St} = new_var_name(St0), 166 Var = #c_var{name=VarName}, 167 Try = #c_try{arg=Core,vars=[Var],body=Var,evars=[],handler=#c_atom{val=false}}, 168 {Try,St}. 169 170%% gexpr_test(Kexpr, State) -> {Kexpr,State}. 171%% Builds the final boolean test from the last Kexpr in a guard test. 172%% Must enter try blocks and isets and find the last Kexpr in them. 173%% This must end in a recognised BEAM test! 174 175gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, 176 name=#k_atom{val=is_boolean},arity=1}=Op, 177 args=Kargs}, St) -> 178 %% XXX Remove this clause in R11. For bootstrap purposes, we must 179 %% recognize erlang:is_boolean/1 here. 180 {#k_test{anno=A,op=Op,args=Kargs},St}; 181gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, 182 name=#k_atom{val=internal_is_record},arity=3}=Op, 183 args=Kargs}, St) -> 184 {#k_test{anno=A,op=Op,args=Kargs},St}; 185gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, 186 name=#k_atom{val=F},arity=Ar}=Op, 187 args=Kargs}=Ke, St) -> 188 %% Either convert to test if ok, or add test. 189 %% At this stage, erlang:float/1 is not a type test. (It should 190 %% have been converted to erlang:is_float/1.) 191 case erl_internal:new_type_test(F, Ar) orelse 192 erl_internal:comp_op(F, Ar) of 193 true -> {#k_test{anno=A,op=Op,args=Kargs},St}; 194 false -> gexpr_test_add(Ke, St) %Add equality test 195 end; 196gexpr_test(#k_try{arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, 197 handler=#k_atom{val=false}}=Try, St0) -> 198 {B,St} = gexpr_test(B0, St0), 199 %%ok = io:fwrite("~w: ~p~n", [?LINE,{B0,B}]), 200 {Try#k_try{arg=B},St}; 201gexpr_test(#iset{body=B0}=Iset, St0) -> 202 {B1,St1} = gexpr_test(B0, St0), 203 {Iset#iset{body=B1},St1}; 204gexpr_test(Ke, St) -> gexpr_test_add(Ke, St). %Add equality test 205 206gexpr_test_add(Ke, St0) -> 207 Test = #k_remote{mod=#k_atom{val='erlang'}, 208 name=#k_atom{val='=:='}, 209 arity=2}, 210 {Ae,Ap,St1} = force_atomic(Ke, St0), 211 {pre_seq(Ap, #k_test{anno=get_kanno(Ke), 212 op=Test,args=[Ae,#k_atom{val='true'}]}),St1}. 213 214%% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}. 215%% Convert a Core expression, flattening it at the same time. 216 217expr(#c_var{anno=A,name=V}, Sub, St) -> 218 {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; 219expr(#c_char{anno=A,val=C}, _Sub, St) -> 220 {#k_int{anno=A,val=C},[],St}; %Convert to integers! 221expr(#c_int{anno=A,val=I}, _Sub, St) -> 222 {#k_int{anno=A,val=I},[],St}; 223expr(#c_float{anno=A,val=F}, _Sub, St) -> 224 {#k_float{anno=A,val=F},[],St}; 225expr(#c_atom{anno=A,val=At}, _Sub, St) -> 226 {#k_atom{anno=A,val=At},[],St}; 227expr(#c_string{anno=A,val=S}, _Sub, St) -> 228 {#k_string{anno=A,val=S},[],St}; 229expr(#c_nil{anno=A}, _Sub, St) -> 230 {#k_nil{anno=A},[],St}; 231expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> 232 %% Do cons in two steps, first the expressions left to right, then 233 %% any remaining literals right to left. 234 {Kh0,Hp0,St1} = expr(Ch, Sub, St0), 235 {Kt0,Tp0,St2} = expr(Ct, Sub, St1), 236 {Kt1,Tp1,St3} = force_atomic(Kt0, St2), 237 {Kh1,Hp1,St4} = force_atomic(Kh0, St3), 238 {#k_cons{anno=A,hd=Kh1,tl=Kt1},Hp0 ++ Tp0 ++ Tp1 ++ Hp1,St4}; 239expr(#c_tuple{anno=A,es=Ces}, Sub, St0) -> 240 {Kes,Ep,St1} = atomic_list(Ces, Sub, St0), 241 {#k_tuple{anno=A,es=Kes},Ep,St1}; 242expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> 243 case catch atomic_bin(Cv, Sub, St0, 0) of 244 {'EXIT',R} -> exit(R); 245 bad_element_size -> 246 Erl = #c_atom{val=erlang}, 247 Name = #c_atom{val=error}, 248 Args = [#c_atom{val=badarg}], 249 Fault = #c_call{module=Erl,name=Name,args=Args}, 250 expr(Fault, Sub, St0); 251 {Kv,Ep,St1} -> 252 {#k_binary{anno=A,segs=Kv},Ep,St1} 253 end; 254expr(#c_fname{anno=A,arity=Ar}=Fname, Sub, St) -> 255 %% A local in an expression. 256 %% For now, these are wrapped into a fun by reverse 257 %% etha-conversion, but really, there should be exactly one 258 %% such "lambda function" for each escaping local name, 259 %% instead of one for each occurrence as done now. 260 Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || 261 V <- integers(1, Ar)], 262 Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{op=Fname,args=Vs}}, 263 expr(Fun, Sub, St); 264expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, St0) -> 265 {Kvs,Sub1,St1} = pattern_list(Cvs, Sub0, St0), 266 %%ok = io:fwrite("~w: ~p~n", [?LINE,{{Cvs,Sub0,St0},{Kvs,Sub1,St1}}]), 267 {Kb,Pb,St2} = body(Cb, Sub1, St1), 268 {#ifun{anno=A,vars=Kvs,body=pre_seq(Pb, Kb)},[],St2}; 269expr(#c_seq{arg=Ca,body=Cb}, Sub, St0) -> 270 {Ka,Pa,St1} = body(Ca, Sub, St0), 271 case is_exit_expr(Ka) of 272 true -> {Ka,Pa,St1}; 273 false -> 274 {Kb,Pb,St2} = body(Cb, Sub, St1), 275 {Kb,Pa ++ [Ka] ++ Pb,St2} 276 end; 277expr(#c_let{anno=A,vars=Cvs,arg=Ca,body=Cb}, Sub0, St0) -> 278 %%ok = io:fwrite("~w: ~p~n", [?LINE,{Cvs,Sub0,St0}]), 279 {Ka,Pa,St1} = body(Ca, Sub0, St0), 280 case is_exit_expr(Ka) of 281 true -> {Ka,Pa,St1}; 282 false -> 283 {Kps,Sub1,St2} = pattern_list(Cvs, Sub0, St1), 284 %%ok = io:fwrite("~w: ~p~n", [?LINE,{Kps,Sub1,St1,St2}]), 285 %% Break known multiple values into separate sets. 286 Sets = case Ka of 287 #ivalues{args=Kas} -> 288 foldr2(fun (V, Val, Sb) -> 289 [#iset{vars=[V],arg=Val}|Sb] end, 290 [], Kps, Kas); 291 _Other -> 292 [#iset{anno=A,vars=Kps,arg=Ka}] 293 end, 294 {Kb,Pb,St3} = body(Cb, Sub1, St2), 295 {Kb,Pa ++ Sets ++ Pb,St3} 296 end; 297expr(#c_letrec{anno=A,defs=Cfs,body=Cb}, Sub0, St0) -> 298 %% Make new function names and store substitution. 299 {Fs0,{Sub1,St1}} = 300 mapfoldl(fun (#c_def{name=#c_fname{id=F,arity=Ar},val=B}, {Sub,St0}) -> 301 {N,St1} = new_fun_name(atom_to_list(F) 302 ++ "/" ++ 303 integer_to_list(Ar), 304 St0), 305 {{N,B},{set_fsub(F, Ar, N, Sub),St1}} 306 end, {Sub0,St0}, Cfs), 307 %% Run translation on functions and body. 308 {Fs1,St2} = mapfoldl(fun ({N,Fd0}, St1) -> 309 {Fd1,[],St2} = expr(Fd0, Sub1, St1), 310 Fd = set_kanno(Fd1, A), 311 {{N,Fd},St2} 312 end, St1, Fs0), 313 {Kb,Pb,St3} = body(Cb, Sub1, St2), 314 {Kb,[#iletrec{anno=A,defs=Fs1}|Pb],St3}; 315expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) -> 316 {Ka,Pa,St1} = body(Ca, Sub, St0), %This is a body! 317 {Kvs,Pv,St2} = match_vars(Ka, St1), %Must have variables here! 318 {Km,St3} = kmatch(Kvs, Ccs, Sub, St2), 319 Match = flatten_seq(build_match(Kvs, Km)), 320 {last(Match),Pa ++ Pv ++ first(Match),St3}; 321expr(#c_receive{anno=A,clauses=Ccs0,timeout=Ce,action=Ca}, Sub, St0) -> 322 {Ke,Pe,St1} = atomic_lit(Ce, Sub, St0), %Force this to be atomic! 323 {Rvar,St2} = new_var(St1), 324 %% Need to massage accept clauses and add reject clause before matching. 325 Ccs1 = map(fun (#c_clause{anno=Banno,body=B0}=C) -> 326 B1 = #c_seq{arg=#ireceive_accept{anno=A},body=B0}, 327 C#c_clause{anno=Banno,body=B1} 328 end, Ccs0), 329 {Mpat,St3} = new_var_name(St2), 330 Rc = #c_clause{anno=[compiler_generated|A], 331 pats=[#c_var{name=Mpat}],guard=#c_atom{anno=A,val=true}, 332 body=#ireceive_next{anno=A}}, 333 {Km,St4} = kmatch([Rvar], Ccs1 ++ [Rc], Sub, add_var_def(Rvar, St3)), 334 {Ka,Pa,St5} = body(Ca, Sub, St4), 335 {#k_receive{anno=A,var=Rvar,body=Km,timeout=Ke,action=pre_seq(Pa, Ka)}, 336 Pe,St5}; 337expr(#c_apply{anno=A,op=Cop,args=Cargs}, Sub, St) -> 338 c_apply(A, Cop, Cargs, Sub, St); 339expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> 340 {[M1,F1|Kargs],Ap,St1} = atomic_list([M0,F0|Cargs], Sub, St0), 341 Ar = length(Cargs), 342 case {M1,F1} of 343 {#k_atom{val=Ma},#k_atom{val=Fa}} -> 344 Call = case is_remote_bif(Ma, Fa, Ar) of 345 true -> 346 #k_bif{anno=A, 347 op=#k_remote{mod=M1,name=F1,arity=Ar}, 348 args=Kargs}; 349 false -> 350 #k_call{anno=A, 351 op=#k_remote{mod=M1,name=F1,arity=Ar}, 352 args=Kargs} 353 end, 354 {Call,Ap,St1}; 355 _Other when St0#kern.extinstr == false -> %Old explicit apply 356 Call = #c_call{anno=A, 357 module=#c_atom{val=erlang}, 358 name=#c_atom{val=apply}, 359 args=[M0,F0,make_list(Cargs)]}, 360 expr(Call, Sub, St0); 361 _Other -> %New instruction in R10. 362 Call = #k_call{anno=A, 363 op=#k_remote{mod=M1,name=F1,arity=Ar}, 364 args=Kargs}, 365 {Call,Ap,St1} 366 end; 367expr(#c_primop{anno=A,name=#c_atom{val=match_fail},args=Cargs}, Sub, St0) -> 368 %% This special case will disappear. 369 {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), 370 Ar = length(Cargs), 371 Call = #k_call{anno=A,op=#k_internal{name=match_fail,arity=Ar},args=Kargs}, 372 {Call,Ap,St1}; 373expr(#c_primop{anno=A,name=#c_atom{val=N},args=Cargs}, Sub, St0) -> 374 {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), 375 Ar = length(Cargs), 376 {#k_bif{anno=A,op=#k_internal{name=N,arity=Ar},args=Kargs},Ap,St1}; 377expr(#c_try{anno=A,arg=Ca,vars=Cvs,body=Cb,evars=Evs,handler=Ch}, Sub0, St0) -> 378 %% The normal try expression. The body and exception handler 379 %% variables behave as let variables. 380 {Ka,Pa,St1} = body(Ca, Sub0, St0), 381 {Kcvs,Sub1,St2} = pattern_list(Cvs, Sub0, St1), 382 {Kb,Pb,St3} = body(Cb, Sub1, St2), 383 {Kevs,Sub2,St4} = pattern_list(Evs, Sub0, St3), 384 {Kh,Ph,St5} = body(Ch, Sub2, St4), 385 {#k_try{anno=A,arg=pre_seq(Pa, Ka), 386 vars=Kcvs,body=pre_seq(Pb, Kb), 387 evars=Kevs,handler=pre_seq(Ph, Kh)},[],St5}; 388expr(#c_catch{anno=A,body=Cb}, Sub, St0) -> 389 {Kb,Pb,St1} = body(Cb, Sub, St0), 390 {#k_catch{anno=A,body=pre_seq(Pb, Kb)},[],St1}; 391%% Handle internal expressions. 392expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}. 393 394%% expr_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}. 395 396% expr_list(Ces, Sub, St) -> 397% foldr(fun (Ce, {Kes,Esp,St0}) -> 398% {Ke,Ep,St1} = expr(Ce, Sub, St0), 399% {[Ke|Kes],Ep ++ Esp,St1} 400% end, {[],[],St}, Ces). 401 402%% match_vars(Kexpr, State) -> {[Kvar],[PreKexpr],State}. 403%% Force return from body into a list of variables. 404 405match_vars(#ivalues{args=As}, St) -> 406 foldr(fun (Ka, {Vs,Vsp,St0}) -> 407 {V,Vp,St1} = force_variable(Ka, St0), 408 {[V|Vs],Vp ++ Vsp,St1} 409 end, {[],[],St}, As); 410match_vars(Ka, St0) -> 411 {V,Vp,St1} = force_variable(Ka, St0), 412 {[V],Vp,St1}. 413 414%% c_apply(A, Op, [Carg], Sub, State) -> {Kexpr,[PreKexpr],State}. 415%% Transform application, detect which are guaranteed to be bifs. 416 417c_apply(A, #c_fname{anno=Ra,id=F0,arity=Ar}, Cargs, Sub, St0) -> 418 {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), 419 F1 = get_fsub(F0, Ar, Sub), %Has it been rewritten 420 {#k_call{anno=A,op=#k_local{anno=Ra,name=F1,arity=Ar},args=Kargs}, 421 Ap,St1}; 422c_apply(A, Cop, Cargs, Sub, St0) -> 423 {Kop,Op,St1} = variable(Cop, Sub, St0), 424 {Kargs,Ap,St2} = atomic_list(Cargs, Sub, St1), 425 {#k_call{anno=A,op=Kop,args=Kargs},Op ++ Ap,St2}. 426 427flatten_seq(#iset{anno=A,vars=Vs,arg=Arg,body=B}) -> 428 [#iset{anno=A,vars=Vs,arg=Arg}|flatten_seq(B)]; 429flatten_seq(Ke) -> [Ke]. 430 431pre_seq([#iset{anno=A,vars=Vs,arg=Arg,body=B}|Ps], K) -> 432 B = undefined, %Assertion. 433 #iset{anno=A,vars=Vs,arg=Arg,body=pre_seq(Ps, K)}; 434pre_seq([P|Ps], K) -> 435 #iset{vars=[],arg=P,body=pre_seq(Ps, K)}; 436pre_seq([], K) -> K. 437 438%% atomic_lit(Cexpr, Sub, State) -> {Katomic,[PreKexpr],State}. 439%% Convert a Core expression making sure the result is an atomic 440%% literal. 441 442atomic_lit(Ce, Sub, St0) -> 443 {Ke,Kp,St1} = expr(Ce, Sub, St0), 444 {Ka,Ap,St2} = force_atomic(Ke, St1), 445 {Ka,Kp ++ Ap,St2}. 446 447force_atomic(Ke, St0) -> 448 case is_atomic(Ke) of 449 true -> {Ke,[],St0}; 450 false -> 451 {V,St1} = new_var(St0), 452 {V,[#iset{vars=[V],arg=Ke}],St1} 453 end. 454 455% force_atomic_list(Kes, St) -> 456% foldr(fun (Ka, {As,Asp,St0}) -> 457% {A,Ap,St1} = force_atomic(Ka, St0), 458% {[A|As],Ap ++ Asp,St1} 459% end, {[],[],St}, Kes). 460 461atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], 462 Sub, St0, B0) -> 463 {E,Ap1,St1} = atomic_lit(E0, Sub, St0), 464 {S1,Ap2,St2} = atomic_lit(S0, Sub, St1), 465 validate_bin_element_size(S1), 466 U0 = core_lib:literal_value(U), 467 Fs0 = core_lib:literal_value(Fs), 468 {B1,Fs1} = aligned(B0, S1, U0, Fs0), 469 {Es,Ap3,St3} = atomic_bin(Es0, Sub, St2, B1), 470 {#k_bin_seg{anno=A,size=S1, 471 unit=U0, 472 type=core_lib:literal_value(T), 473 flags=Fs1, 474 seg=E,next=Es}, 475 Ap1++Ap2++Ap3,St3}; 476atomic_bin([], _Sub, St, _Bits) -> {#k_bin_end{},[],St}. 477 478validate_bin_element_size(#k_var{}) -> ok; 479validate_bin_element_size(#k_int{val=V}) when V >= 0 -> ok; 480validate_bin_element_size(#k_atom{val=all}) -> ok; 481validate_bin_element_size(_) -> throw(bad_element_size). 482 483%% atomic_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}. 484 485atomic_list(Ces, Sub, St) -> 486 foldr(fun (Ce, {Kes,Esp,St0}) -> 487 {Ke,Ep,St1} = atomic_lit(Ce, Sub, St0), 488 {[Ke|Kes],Ep ++ Esp,St1} 489 end, {[],[],St}, Ces). 490 491%% is_atomic(Kexpr) -> boolean(). 492%% Is a Kexpr atomic? Strings are NOT considered atomic! 493 494is_atomic(#k_int{}) -> true; 495is_atomic(#k_float{}) -> true; 496is_atomic(#k_atom{}) -> true; 497%%is_atomic(#k_char{}) -> true; %No characters 498%%is_atomic(#k_string{}) -> true; 499is_atomic(#k_nil{}) -> true; 500is_atomic(#k_var{}) -> true; 501is_atomic(_) -> false. 502 503%% variable(Cexpr, Sub, State) -> {Kvar,[PreKexpr],State}. 504%% Convert a Core expression making sure the result is a variable. 505 506variable(Ce, Sub, St0) -> 507 {Ke,Kp,St1} = expr(Ce, Sub, St0), 508 {Kv,Vp,St2} = force_variable(Ke, St1), 509 {Kv,Kp ++ Vp,St2}. 510 511force_variable(#k_var{}=Ke, St) -> {Ke,[],St}; 512force_variable(Ke, St0) -> 513 {V,St1} = new_var(St0), 514 {V,[#iset{vars=[V],arg=Ke}],St1}. 515 516%% pattern(Cpat, Sub, State) -> {Kpat,Sub,State}. 517%% Convert patterns. Variables shadow so rename variables that are 518%% already defined. 519 520pattern(#c_var{anno=A,name=V}, Sub, St0) -> 521 case sets:is_element(V, St0#kern.ds) of 522 true -> 523 {New,St1} = new_var_name(St0), 524 {#k_var{anno=A,name=New}, 525 set_vsub(V, New, Sub), 526 St1#kern{ds=sets:add_element(New, St1#kern.ds)}}; 527 false -> 528 {#k_var{anno=A,name=V},Sub, 529 St0#kern{ds=sets:add_element(V, St0#kern.ds)}} 530 end; 531pattern(#c_char{anno=A,val=C}, Sub, St) -> 532 {#k_int{anno=A,val=C},Sub,St}; %Convert to integers! 533pattern(#c_int{anno=A,val=I}, Sub, St) -> 534 {#k_int{anno=A,val=I},Sub,St}; 535pattern(#c_float{anno=A,val=F}, Sub, St) -> 536 {#k_float{anno=A,val=F},Sub,St}; 537pattern(#c_atom{anno=A,val=At}, Sub, St) -> 538 {#k_atom{anno=A,val=At},Sub,St}; 539pattern(#c_string{val=S}, Sub, St) -> 540 L = foldr(fun (C, T) -> #k_cons{hd=#k_int{val=C},tl=T} end, 541 #k_nil{}, S), 542 {L,Sub,St}; 543pattern(#c_nil{anno=A}, Sub, St) -> 544 {#k_nil{anno=A},Sub,St}; 545pattern(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub0, St0) -> 546 {Kh,Sub1,St1} = pattern(Ch, Sub0, St0), 547 {Kt,Sub2,St2} = pattern(Ct, Sub1, St1), 548 {#k_cons{anno=A,hd=Kh,tl=Kt},Sub2,St2}; 549pattern(#c_tuple{anno=A,es=Ces}, Sub0, St0) -> 550 {Kes,Sub1,St1} = pattern_list(Ces, Sub0, St0), 551 {#k_tuple{anno=A,es=Kes},Sub1,St1}; 552pattern(#c_binary{anno=A,segments=Cv}, Sub0, St0) -> 553 {Kv,Sub1,St1} = pattern_bin(Cv, Sub0, St0), 554 {#k_binary{anno=A,segs=Kv},Sub1,St1}; 555pattern(#c_alias{anno=A,var=Cv,pat=Cp}, Sub0, St0) -> 556 {Cvs,Cpat} = flatten_alias(Cp), 557 {Kvs,Sub1,St1} = pattern_list([Cv|Cvs], Sub0, St0), 558 {Kpat,Sub2,St2} = pattern(Cpat, Sub1, St1), 559 {#ialias{anno=A,vars=Kvs,pat=Kpat},Sub2,St2}. 560 561flatten_alias(#c_alias{var=V,pat=P}) -> 562 {Vs,Pat} = flatten_alias(P), 563 {[V|Vs],Pat}; 564flatten_alias(Pat) -> {[],Pat}. 565 566pattern_bin(Es, Sub, St) -> pattern_bin(Es, Sub, St, 0). 567 568pattern_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], 569 Sub0, St0, B0) -> 570 {S1,[],St1} = expr(S0, Sub0, St0), 571 U0 = core_lib:literal_value(U), 572 Fs0 = core_lib:literal_value(Fs), 573 %%ok= io:fwrite("~w: ~p~n", [?LINE,{B0,S1,U0,Fs0}]), 574 {B1,Fs1} = aligned(B0, S1, U0, Fs0), 575 {E,Sub1,St2} = pattern(E0, Sub0, St1), 576 {Es,Sub2,St3} = pattern_bin(Es0, Sub1, St2, B1), 577 {#k_bin_seg{anno=A,size=S1, 578 unit=U0, 579 type=core_lib:literal_value(T), 580 flags=Fs1, 581 seg=E,next=Es}, 582 Sub2,St3}; 583pattern_bin([], Sub, St, _Bits) -> {#k_bin_end{},Sub,St}. 584 585%% pattern_list([Cexpr], Sub, State) -> {[Kexpr],Sub,State}. 586 587pattern_list(Ces, Sub, St) -> 588 foldr(fun (Ce, {Kes,Sub0,St0}) -> 589 {Ke,Sub1,St1} = pattern(Ce, Sub0, St0), 590 {[Ke|Kes],Sub1,St1} 591 end, {[],Sub,St}, Ces). 592 593%% new_sub() -> Subs. 594%% set_vsub(Name, Sub, Subs) -> Subs. 595%% subst_vsub(Name, Sub, Subs) -> Subs. 596%% get_vsub(Name, Subs) -> SubName. 597%% Add/get substitute Sub for Name to VarSub. Use orddict so we know 598%% the format is a list {Name,Sub} pairs. When adding a new 599%% substitute we fold substitute chains so we never have to search 600%% more than once. 601 602new_sub() -> orddict:new(). 603 604get_vsub(V, Vsub) -> 605 case orddict:find(V, Vsub) of 606 {ok,Val} -> Val; 607 error -> V 608 end. 609 610set_vsub(V, S, Vsub) -> 611 orddict:store(V, S, Vsub). 612 613subst_vsub(V, S, Vsub0) -> 614 %% Fold chained substitutions. 615 Vsub1 = orddict:map(fun (_, V1) when V1 =:= V -> S; 616 (_, V1) -> V1 617 end, Vsub0), 618 orddict:store(V, S, Vsub1). 619 620get_fsub(F, A, Fsub) -> 621 case orddict:find({F,A}, Fsub) of 622 {ok,Val} -> Val; 623 error -> F 624 end. 625 626set_fsub(F, A, S, Fsub) -> 627 orddict:store({F,A}, S, Fsub). 628 629new_fun_name(St) -> 630 new_fun_name("anonymous", St). 631 632%% new_fun_name(Type, State) -> {FunName,State}. 633 634new_fun_name(Type, #kern{func={F,Arity},fcount=C}=St) -> 635 Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(Arity) ++ 636 "-" ++ Type ++ "-" ++ integer_to_list(C) ++ "-", 637 {list_to_atom(Name),St#kern{fcount=C+1}}. 638 639%% new_var_name(State) -> {VarName,State}. 640 641new_var_name(#kern{vcount=C}=St) -> 642 {list_to_atom("ker" ++ integer_to_list(C)),St#kern{vcount=C+1}}. 643 644%% new_var(State) -> {#k_var{},State}. 645 646new_var(St0) -> 647 {New,St1} = new_var_name(St0), 648 {#k_var{name=New},St1}. 649 650%% new_vars(Count, State) -> {[#k_var{}],State}. 651%% Make Count new variables. 652 653new_vars(N, St) -> new_vars(N, St, []). 654 655new_vars(N, St0, Vs) when N > 0 -> 656 {V,St1} = new_var(St0), 657 new_vars(N-1, St1, [V|Vs]); 658new_vars(0, St, Vs) -> {Vs,St}. 659 660make_vars(Vs) -> [ #k_var{name=V} || V <- Vs ]. 661 662add_var_def(V, St) -> 663 St#kern{ds=sets:add_element(V#k_var.name, St#kern.ds)}. 664 665%%add_vars_def(Vs, St) -> 666%% Ds = foldl(fun (#k_var{name=V}, Ds) -> add_element(V, Ds) end, 667%% St#kern.ds, Vs), 668%% St#kern{ds=Ds}. 669 670%% is_remote_bif(Mod, Name, Arity) -> true | false. 671%% Test if function is really a BIF. 672 673is_remote_bif(erlang, is_boolean, 1) -> 674 %% XXX Remove this clause in R11. For bootstrap purposes, we must 675 %% recognize erlang:is_boolean/1 here. 676 true; 677is_remote_bif(erlang, internal_is_record, 3) -> true; 678is_remote_bif(erlang, get, 1) -> true; 679is_remote_bif(erlang, N, A) -> 680 case erl_internal:guard_bif(N, A) of 681 true -> true; 682 false -> 683 case erl_internal:type_test(N, A) of 684 true -> true; 685 false -> 686 case catch erl_internal:op_type(N, A) of 687 arith -> true; 688 bool -> true; 689 comp -> true; 690 _Other -> false %List, send or not an op 691 end 692 end 693 end; 694is_remote_bif(_, _, _) -> false. 695 696%% bif_vals(Name, Arity) -> integer(). 697%% bif_vals(Mod, Name, Arity) -> integer(). 698%% Determine how many return values a BIF has. Provision for BIFs to 699%% return multiple values. Only used in bodies where a BIF may be 700%% called for effect only. 701 702bif_vals(dsetelement, 3) -> 0; 703bif_vals(_, _) -> 1. 704 705bif_vals(_, _, _) -> 1. 706 707%% foldr2(Fun, Acc, List1, List2) -> Acc. 708%% Fold over two lists. 709 710foldr2(Fun, Acc0, [E1|L1], [E2|L2]) -> 711 Acc1 = Fun(E1, E2, Acc0), 712 foldr2(Fun, Acc1, L1, L2); 713foldr2(_, Acc, [], []) -> Acc. 714 715%% first([A]) -> [A]. 716%% last([A]) -> A. 717 718last([L]) -> L; 719last([_|T]) -> last(T). 720 721first([_]) -> []; 722first([H|T]) -> [H|first(T)]. 723 724%% This code implements the algorithm for an optimizing compiler for 725%% pattern matching given "The Implementation of Functional 726%% Programming Languages" by Simon Peyton Jones. The code is much 727%% longer as the meaning of constructors is different from the book. 728%% 729%% In Erlang many constructors can have different values, e.g. 'atom' 730%% or 'integer', whereas in the original algorithm thse would be 731%% different constructors. Our view makes it easier in later passes to 732%% handle indexing over each type. 733%% 734%% Patterns are complicated by having alias variables. The form of a 735%% pattern is Pat | {alias,Pat,[AliasVar]}. This is hidden by access 736%% functions to pattern arguments but the code must be aware of it. 737%% 738%% The compilation proceeds in two steps: 739%% 740%% 1. The patterns in the clauses to converted to lists of kernel 741%% patterns. The Core clause is now hybrid, this is easier to work 742%% with. Remove clauses with trivially false guards, this simplifies 743%% later passes. Add local defined vars and variable subs to each 744%% clause for later use. 745%% 746%% 2. The pattern matching is optimised. Variable substitutions are 747%% added to the VarSub structure and new variables are made visible. 748%% The guard and body are then converted to Kernel form. 749 750%% kmatch([Var], [Clause], Sub, State) -> {Kexpr,[PreExpr],State}. 751 752kmatch(Us, Ccs, Sub, St0) -> 753 {Cs,St1} = match_pre(Ccs, Sub, St0), %Convert clauses 754 %%Def = kernel_match_error, %The strict case 755 %% This should be a kernel expression from the first pass. 756 Def = #k_call{anno=[compiler_generated], 757 op=#k_remote{mod=#k_atom{val=erlang}, 758 name=#k_atom{val=exit}, 759 arity=1}, 760 args=[#k_atom{val=kernel_match_error}]}, 761 {Km,St2} = match(Us, Cs, Def, St1), %Do the match. 762 {Km,St2}. 763 764%% match_pre([Cclause], Sub, State) -> {[Clause],State}. 765%% Must be careful not to generate new substitutions here now! 766%% Remove clauses with trivially false guards which will never 767%% succeed. 768 769match_pre(Cs, Sub0, St) -> 770 foldr(fun (#c_clause{anno=A,pats=Ps,guard=G,body=B}, {Cs0,St0}) -> 771 case is_false_guard(G) of 772 true -> {Cs0,St0}; 773 false -> 774 {Kps,Sub1,St1} = pattern_list(Ps, Sub0, St0), 775 {[#iclause{anno=A,sub=Sub1,pats=Kps,guard=G,body=B}| 776 Cs0],St1} 777 end 778 end, {[],St}, Cs). 779 780%% match([Var], [Clause], Default, State) -> {MatchExpr,State}. 781 782match([U|Us], Cs, Def, St0) -> 783 %%ok = io:format("match ~p~n", [Cs]), 784 Pcss = partition(Cs), 785 foldr(fun (Pcs, {D,St}) -> match_varcon([U|Us], Pcs, D, St) end, 786 {Def,St0}, Pcss); 787match([], Cs, Def, St) -> 788 match_guard(Cs, Def, St). 789 790%% match_guard([Clause], Default, State) -> {IfExpr,State}. 791%% Build a guard to handle guards. A guard *ALWAYS* fails if no 792%% clause matches, there will be a surrounding 'alt' to catch the 793%% failure. Drop redundant cases, i.e. those after a true guard. 794 795match_guard(Cs0, Def0, St0) -> 796 {Cs1,Def1,St1} = match_guard_1(Cs0, Def0, St0), 797 {build_alt(build_guard(Cs1), Def1),St1}. 798 799match_guard_1([#iclause{anno=A,sub=Sub,guard=G,body=B}|Cs0], Def0, St0) -> 800 case is_true_guard(G) of 801 true -> 802 %% The true clause body becomes the default. 803 {Kb,Pb,St1} = body(B, Sub, St0), 804 Line = get_line(A), 805 St2 = maybe_add_warning(Cs0, Line, St1), 806 St = maybe_add_warning(Def0, Line, St2), 807 {[],pre_seq(Pb, Kb),St}; 808 false -> 809 {Kg,St1} = guard(G, Sub, St0), 810 {Kb,Pb,St2} = body(B, Sub, St1), 811 {Cs1,Def1,St3} = match_guard_1(Cs0, Def0, St2), 812 {[#k_guard_clause{guard=Kg,body=pre_seq(Pb, Kb)}|Cs1], 813 Def1,St3} 814 end; 815match_guard_1([], Def, St) -> {[],Def,St}. 816 817maybe_add_warning([C|_], Line, St) -> 818 maybe_add_warning(C, Line, St); 819maybe_add_warning([], _Line, St) -> St; 820maybe_add_warning(fail, _Line, St) -> St; 821maybe_add_warning(Ke, MatchLine, St) -> 822 case get_kanno(Ke) of 823 [compiler_generated|_] -> St; 824 Anno -> 825 Line = get_line(Anno), 826 Warn = case MatchLine of 827 none -> nomatch_shadow; 828 _ -> {nomatch_shadow,MatchLine} 829 end, 830 add_warning(Line, Warn, St) 831 end. 832 833get_line([Line|_]) when is_integer(Line) -> Line; 834get_line([_|T]) -> get_line(T); 835get_line([]) -> none. 836 837 838%% is_true_guard(Guard) -> boolean(). 839%% is_false_guard(Guard) -> boolean(). 840%% Test if a guard is either trivially true/false. This has probably 841%% already been optimised away, but what the heck! 842 843is_true_guard(G) -> guard_value(G) == true. 844is_false_guard(G) -> guard_value(G) == false. 845 846%% guard_value(Guard) -> true | false | unknown. 847 848guard_value(#c_atom{val=true}) -> true; 849guard_value(#c_atom{val=false}) -> false; 850guard_value(#c_call{module=#c_atom{val=erlang}, 851 name=#c_atom{val='not'}, 852 args=[A]}) -> 853 case guard_value(A) of 854 true -> false; 855 false -> true; 856 unknown -> unknown 857 end; 858guard_value(#c_call{module=#c_atom{val=erlang}, 859 name=#c_atom{val='and'}, 860 args=[Ca,Cb]}) -> 861 case guard_value(Ca) of 862 true -> guard_value(Cb); 863 false -> false; 864 unknown -> 865 case guard_value(Cb) of 866 false -> false; 867 _Other -> unknown 868 end 869 end; 870guard_value(#c_call{module=#c_atom{val=erlang}, 871 name=#c_atom{val='or'}, 872 args=[Ca,Cb]}) -> 873 case guard_value(Ca) of 874 true -> true; 875 false -> guard_value(Cb); 876 unknown -> 877 case guard_value(Cb) of 878 true -> true; 879 _Other -> unknown 880 end 881 end; 882guard_value(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, 883 handler=#c_atom{val=false}}) -> 884 guard_value(E); 885guard_value(_) -> unknown. 886 887%% partition([Clause]) -> [[Clause]]. 888%% Partition a list of clauses into groups which either contain 889%% clauses with a variable first argument, or with a "constructor". 890 891partition([C1|Cs]) -> 892 V1 = is_var_clause(C1), 893 {More,Rest} = splitwith(fun (C) -> is_var_clause(C) == V1 end, Cs), 894 [[C1|More]|partition(Rest)]; 895partition([]) -> []. 896 897%% match_varcon([Var], [Clause], Def, [Var], Sub, State) -> 898%% {MatchExpr,State}. 899 900match_varcon(Us, [C|_]=Cs, Def, St) -> 901 case is_var_clause(C) of 902 true -> match_var(Us, Cs, Def, St); 903 false -> match_con(Us, Cs, Def, St) 904 end. 905 906%% match_var([Var], [Clause], Def, State) -> {MatchExpr,State}. 907%% Build a call to "select" from a list of clauses all containing a 908%% variable as the first argument. We must rename the variable in 909%% each clause to be the match variable as these clause will share 910%% this variable and may have different names for it. Rename aliases 911%% as well. 912 913match_var([U|Us], Cs0, Def, St) -> 914 Cs1 = map(fun (#iclause{sub=Sub0,pats=[Arg|As]}=C) -> 915 Vs = [arg_arg(Arg)|arg_alias(Arg)], 916 Sub1 = foldl(fun (#k_var{name=V}, Acc) -> 917 subst_vsub(V, U#k_var.name, Acc) 918 end, Sub0, Vs), 919 C#iclause{sub=Sub1,pats=As} 920 end, Cs0), 921 match(Us, Cs1, Def, St). 922 923%% match_con(Variables, [Clause], Default, State) -> {SelectExpr,State}. 924%% Build call to "select" from a list of clauses all containing a 925%% constructor/constant as first argument. Group the constructors 926%% according to type, the order is really irrelevant but tries to be 927%% smart. 928 929match_con([U|Us], Cs, Def, St0) -> 930 %% Extract clauses for different constructors (types). 931 %%ok = io:format("match_con ~p~n", [Cs]), 932 Ttcs = [ {T,Tcs} || T <- [k_cons,k_tuple,k_atom,k_float,k_int,k_nil, 933 k_binary,k_bin_end], 934 begin Tcs = select(T, Cs), 935 Tcs /= [] 936 end ] ++ select_bin_con(Cs), 937 %%ok = io:format("ttcs = ~p~n", [Ttcs]), 938 {Scs,St1} = 939 mapfoldl(fun ({T,Tcs}, St) -> 940 {[S|_]=Sc,S1} = match_value([U|Us], T, Tcs, fail, St), 941 %%ok = io:format("match_con type2 ~p~n", [T]), 942 Anno = get_kanno(S), 943 {#k_type_clause{anno=Anno,type=T,values=Sc},S1} end, 944 St0, Ttcs), 945 {build_alt_1st_no_fail(build_select(U, Scs), Def),St1}. 946 947%% select_bin_con([Clause]) -> [{Type,[Clause]}]. 948%% Extract clauses for the k_bin_seg constructor. As k_bin_seg 949%% matching can overlap, the k_bin_seg constructors cannot be 950%% reordered, only grouped. 951 952select_bin_con(Cs0) -> 953 Cs1 = lists:filter(fun (C) -> 954 clause_con(C) == k_bin_seg 955 end, Cs0), 956 select_bin_con_1(Cs1). 957 958select_bin_con_1([C1|Cs]) -> 959 Con = clause_con(C1), 960 {More,Rest} = splitwith(fun (C) -> clause_con(C) == Con end, Cs), 961 [{Con,[C1|More]}|select_bin_con_1(Rest)]; 962select_bin_con_1([]) -> []. 963 964%% select(Con, [Clause]) -> [Clause]. 965 966select(T, Cs) -> [ C || C <- Cs, clause_con(C) == T ]. 967 968%% match_value([Var], Con, [Clause], Default, State) -> {SelectExpr,State}. 969%% At this point all the clauses have the same constructor, we must 970%% now separate them according to value. 971 972match_value(_, _, [], _, St) -> {[],St}; 973match_value(Us, T, Cs0, Def, St0) -> 974 Css = group_value(T, Cs0), 975 %%ok = io:format("match_value ~p ~p~n", [T, Css]), 976 {Css1,St1} = mapfoldl(fun (Cs, St) -> 977 match_clause(Us, Cs, Def, St) end, 978 St0, Css), 979 {Css1,St1}. 980 %%{#k_select_val{type=T,var=hd(Us),clauses=Css1},St1}. 981 982%% group_value([Clause]) -> [[Clause]]. 983%% Group clauses according to value. Here we know that 984%% 1. Some types are singled valued 985%% 2. The clauses in bin_segs cannot be reordered only grouped 986%% 3. Other types are disjoint and can be reordered 987 988group_value(k_cons, Cs) -> [Cs]; %These are single valued 989group_value(k_nil, Cs) -> [Cs]; 990group_value(k_binary, Cs) -> [Cs]; 991group_value(k_bin_end, Cs) -> [Cs]; 992group_value(k_bin_seg, Cs) -> 993 group_bin_seg(Cs); 994group_value(_, Cs) -> 995 %% group_value(Cs). 996 Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end, 997 dict:new(), Cs), 998 dict:fold(fun (_, Vcs, Css) -> [Vcs|Css] end, [], Cd). 999 1000group_bin_seg([C1|Cs]) -> 1001 V1 = clause_val(C1), 1002 {More,Rest} = splitwith(fun (C) -> clause_val(C) == V1 end, Cs), 1003 [[C1|More]|group_bin_seg(Rest)]; 1004group_bin_seg([]) -> []. 1005 1006%% Profiling shows that this quadratic implementation account for a big amount 1007%% of the execution time if there are many values. 1008% group_value([C|Cs]) -> 1009% V = clause_val(C), 1010% Same = [ Cv || Cv <- Cs, clause_val(Cv) == V ], %Same value 1011% Rest = [ Cv || Cv <- Cs, clause_val(Cv) /= V ], % and all the rest 1012% [[C|Same]|group_value(Rest)]; 1013% group_value([]) -> []. 1014 1015%% match_clause([Var], [Clause], Default, State) -> {Clause,State}. 1016%% At this point all the clauses have the same "value". Build one 1017%% select clause for this value and continue matching. Rename 1018%% aliases as well. 1019 1020match_clause([U|Us], [C|_]=Cs0, Def, St0) -> 1021 Anno = get_kanno(C), 1022 {Match0,Vs,St1} = get_match(get_con(Cs0), St0), 1023 Match = sub_size_var(Match0, Cs0), 1024 {Cs1,St2} = new_clauses(Cs0, U, St1), 1025 {B,St3} = match(Vs ++ Us, Cs1, Def, St2), 1026 {#k_val_clause{anno=Anno,val=Match,body=B},St3}. 1027 1028sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{sub=Sub}|_]) -> 1029 BinSeg#k_bin_seg{size=Kvar#k_var{name=get_vsub(Name, Sub)}}; 1030sub_size_var(K, _) -> K. 1031 1032get_con([C|_]) -> arg_arg(clause_arg(C)). %Get the constructor 1033 1034get_match(#k_cons{}, St0) -> 1035 {[H,T],St1} = new_vars(2, St0), 1036 {#k_cons{hd=H,tl=T},[H,T],St1}; 1037get_match(#k_binary{}, St0) -> 1038 {[V]=Mes,St1} = new_vars(1, St0), 1039 {#k_binary{segs=V},Mes,St1}; 1040get_match(#k_bin_seg{}=Seg, St0) -> 1041 {[S,N]=Mes,St1} = new_vars(2, St0), 1042 {Seg#k_bin_seg{seg=S,next=N},Mes,St1}; 1043get_match(#k_tuple{es=Es}, St0) -> 1044 {Mes,St1} = new_vars(length(Es), St0), 1045 {#k_tuple{es=Mes},Mes,St1}; 1046get_match(M, St) -> 1047 {M,[],St}. 1048 1049new_clauses(Cs0, U, St) -> 1050 Cs1 = map(fun (#iclause{sub=Sub0,pats=[Arg|As]}=C) -> 1051 Head = case arg_arg(Arg) of 1052 #k_cons{hd=H,tl=T} -> [H,T|As]; 1053 #k_tuple{es=Es} -> Es ++ As; 1054 #k_binary{segs=E} -> [E|As]; 1055 #k_bin_seg{seg=S,next=N} -> 1056 [S,N|As]; 1057 _Other -> As 1058 end, 1059 Vs = arg_alias(Arg), 1060 Sub1 = foldl(fun (#k_var{name=V}, Acc) -> 1061 subst_vsub(V, U#k_var.name, Acc) 1062 end, Sub0, Vs), 1063 C#iclause{sub=Sub1,pats=Head} 1064 end, Cs0), 1065 {Cs1,St}. 1066 1067%% build_guard([GuardClause]) -> GuardExpr. 1068 1069build_guard([]) -> fail; 1070build_guard(Cs) -> #k_guard{clauses=Cs}. 1071 1072%% build_select(Var, [ConClause]) -> SelectExpr. 1073 1074build_select(V, [Tc|_]=Tcs) -> 1075 Anno = get_kanno(Tc), 1076 #k_select{anno=Anno,var=V,types=Tcs}. 1077 1078%% build_alt(First, Then) -> AltExpr. 1079%% Build an alt, attempt some simple optimisation. 1080 1081build_alt(fail, Then) -> Then; 1082build_alt(First,Then) -> build_alt_1st_no_fail(First, Then). 1083 1084build_alt_1st_no_fail(First, fail) -> First; 1085build_alt_1st_no_fail(First, Then) -> #k_alt{first=First,then=Then}. 1086 1087%% build_match([MatchVar], MatchExpr) -> Kexpr. 1088%% Build a match expr if there is a match. 1089 1090build_match(Us, #k_alt{}=Km) -> #k_match{vars=Us,body=Km}; 1091build_match(Us, #k_select{}=Km) -> #k_match{vars=Us,body=Km}; 1092build_match(Us, #k_guard{}=Km) -> #k_match{vars=Us,body=Km}; 1093build_match(_, Km) -> Km. 1094 1095%% clause_arg(Clause) -> FirstArg. 1096%% clause_con(Clause) -> Constructor. 1097%% clause_val(Clause) -> Value. 1098%% is_var_clause(Clause) -> boolean(). 1099 1100clause_arg(#iclause{pats=[Arg|_]}) -> Arg. 1101 1102clause_con(C) -> arg_con(clause_arg(C)). 1103 1104clause_val(C) -> arg_val(clause_arg(C)). 1105 1106is_var_clause(C) -> clause_con(C) == k_var. 1107 1108%% arg_arg(Arg) -> Arg. 1109%% arg_alias(Arg) -> Aliases. 1110%% arg_con(Arg) -> Constructor. 1111%% arg_val(Arg) -> Value. 1112%% These are the basic functions for obtaining fields in an argument. 1113 1114arg_arg(#ialias{pat=Con}) -> Con; 1115arg_arg(Con) -> Con. 1116 1117arg_alias(#ialias{vars=As}) -> As; 1118arg_alias(_Con) -> []. 1119 1120arg_con(Arg) -> 1121 case arg_arg(Arg) of 1122 #k_int{} -> k_int; 1123 #k_float{} -> k_float; 1124 #k_atom{} -> k_atom; 1125 #k_nil{} -> k_nil; 1126 #k_cons{} -> k_cons; 1127 #k_tuple{} -> k_tuple; 1128 #k_binary{} -> k_binary; 1129 #k_bin_end{} -> k_bin_end; 1130 #k_bin_seg{} -> k_bin_seg; 1131 #k_var{} -> k_var 1132 end. 1133 1134arg_val(Arg) -> 1135 case arg_arg(Arg) of 1136 #k_int{val=I} -> I; 1137 #k_float{val=F} -> F; 1138 #k_atom{val=A} -> A; 1139 #k_nil{} -> 0; 1140 #k_cons{} -> 2; 1141 #k_tuple{es=Es} -> length(Es); 1142 #k_bin_seg{size=S,unit=U,type=T,flags=Fs} -> 1143 {set_kanno(S, []),U,T,Fs}; 1144 #k_bin_end{} -> 0; 1145 #k_binary{} -> 0 1146 end. 1147 1148%% ubody(Expr, Break, State) -> {Expr,[UsedVar],State}. 1149%% Tag the body sequence with its used variables. These bodies 1150%% either end with a #k_break{}, or with #k_return{} or an expression 1151%% which itself can return, #k_enter{}, #k_match{} ... . 1152 1153ubody(#iset{vars=[],arg=#iletrec{}=Let,body=B0}, Br, St0) -> 1154 %% An iletrec{} should never be last. 1155 St1 = iletrec_funs(Let, St0), 1156 ubody(B0, Br, St1); 1157ubody(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Br, St0) -> 1158 {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0), 1159 {B1,Bu,St2} = ubody(B0, Br, St1), 1160 Ns = lit_list_vars(Vs), 1161 Used = union(Eu, subtract(Bu, Ns)), %Used external vars 1162 {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; 1163ubody(#ivalues{anno=A,args=As}, return, St) -> 1164 Au = lit_list_vars(As), 1165 {#k_return{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; 1166ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) -> 1167 Au = lit_list_vars(As), 1168 {#k_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; 1169ubody(E, return, St0) -> 1170 %% Enterable expressions need no trailing return. 1171 case is_enter_expr(E) of 1172 true -> uexpr(E, return, St0); 1173 false -> 1174 {Ea,Pa,St1} = force_atomic(E, St0), 1175 ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1) 1176 end; 1177ubody(E, {break,Rs}, St0) -> 1178 %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]), 1179 %% Exiting expressions need no trailing break. 1180 case is_exit_expr(E) of 1181 true -> uexpr(E, return, St0); 1182 false -> 1183 {Ea,Pa,St1} = force_atomic(E, St0), 1184 ubody(pre_seq(Pa, #ivalues{args=[Ea]}), {break,Rs}, St1) 1185 end. 1186 1187iletrec_funs(#iletrec{defs=Fs}, St0) -> 1188 %% Use union of all free variables. 1189 %% First just work out free variables for all functions. 1190 Free = foldl(fun ({_,#ifun{vars=Vs,body=Fb0}}, Free0) -> 1191 {_,Fbu,_} = ubody(Fb0, return, St0), 1192 Ns = lit_list_vars(Vs), 1193 Free1 = subtract(Fbu, Ns), 1194 union(Free1, Free0) 1195 end, [], Fs), 1196 FreeVs = make_vars(Free), 1197 %% Add this free info to State. 1198 St1 = foldl(fun ({N,#ifun{vars=Vs}}, Lst) -> 1199 store_free(N, length(Vs), FreeVs, Lst) 1200 end, St0, Fs), 1201 %% Now regenerate local functions to use free variable information. 1202 St2 = foldl(fun ({N,#ifun{anno=Fa,vars=Vs,body=Fb0}}, Lst0) -> 1203 {Fb1,_,Lst1} = ubody(Fb0, return, Lst0), 1204 Arity = length(Vs) + length(FreeVs), 1205 Fun = #k_fdef{anno=#k{us=[],ns=[],a=Fa}, 1206 func=N,arity=Arity, 1207 vars=Vs ++ FreeVs,body=Fb1}, 1208 Lst1#kern{funs=[Fun|Lst1#kern.funs]} 1209 end, St1, Fs), 1210 St2. 1211 1212%% is_exit_expr(Kexpr) -> boolean(). 1213%% Test whether Kexpr always exits and never returns. 1214 1215is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=throw,arity=1}}) -> true; 1216is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=exit,arity=1}}) -> true; 1217is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=error,arity=1}}) -> true; 1218is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=error,arity=2}}) -> true; 1219is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=fault,arity=1}}) -> true; 1220is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=fault,arity=2}}) -> true; 1221is_exit_expr(#k_call{op=#k_internal{name=match_fail,arity=1}}) -> true; 1222is_exit_expr(#k_bif{op=#k_internal{name=rethrow,arity=2}}) -> true; 1223is_exit_expr(#k_receive_next{}) -> true; 1224is_exit_expr(_) -> false. 1225 1226%% is_enter_expr(Kexpr) -> boolean(). 1227%% Test whether Kexpr is "enterable", i.e. can handle return from 1228%% within itself without extra #k_return{}. 1229 1230is_enter_expr(#k_call{}) -> true; 1231is_enter_expr(#k_match{}) -> true; 1232is_enter_expr(#k_receive{}) -> true; 1233is_enter_expr(#k_receive_next{}) -> true; 1234%%is_enter_expr(#k_try{}) -> true; %Soon 1235is_enter_expr(_) -> false. 1236 1237%% uguard(Expr, State) -> {Expr,[UsedVar],State}. 1238%% Tag the guard sequence with its used variables. 1239 1240uguard(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, 1241 handler=#k_atom{val=false}}=Try, St0) -> 1242 {B1,Bu,St1} = uguard(B0, St0), 1243 {Try#k_try{anno=#k{us=Bu,ns=[],a=A},arg=B1},Bu,St1}; 1244uguard(T, St) -> 1245 %%ok = io:fwrite("~w: ~p~n", [?LINE,T]), 1246 uguard_test(T, St). 1247 1248%% uguard_test(Expr, State) -> {Test,[UsedVar],State}. 1249%% At this stage tests are just expressions which don't return any 1250%% values. 1251 1252uguard_test(T, St) -> uguard_expr(T, [], St). 1253 1254uguard_expr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Rs, St0) -> 1255 Ns = lit_list_vars(Vs), 1256 {E1,Eu,St1} = uguard_expr(E0, Vs, St0), 1257 {B1,Bu,St2} = uguard_expr(B0, Rs, St1), 1258 Used = union(Eu, subtract(Bu, Ns)), 1259 {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; 1260uguard_expr(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, 1261 handler=#k_atom{val=false}}=Try, Rs, St0) -> 1262 {B1,Bu,St1} = uguard_expr(B0, Rs, St0), 1263 {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},arg=B1,ret=Rs}, 1264 Bu,St1}; 1265uguard_expr(#k_test{anno=A,op=Op,args=As}=Test, Rs, St) -> 1266 [] = Rs, %Sanity check 1267 Used = union(op_vars(Op), lit_list_vars(As)), 1268 {Test#k_test{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}}, 1269 Used,St}; 1270uguard_expr(#k_bif{anno=A,op=Op,args=As}=Bif, Rs, St) -> 1271 Used = union(op_vars(Op), lit_list_vars(As)), 1272 {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs}, 1273 Used,St}; 1274uguard_expr(#ivalues{anno=A,args=As}, Rs, St) -> 1275 Sets = foldr2(fun (V, Arg, Rhs) -> 1276 #iset{anno=A,vars=[V],arg=Arg,body=Rhs} 1277 end, #k_atom{val=true}, Rs, As), 1278 uguard_expr(Sets, [], St); 1279uguard_expr(#k_match{anno=A,vars=Vs,body=B0}, Rs, St0) -> 1280 %% Experimental support for andalso/orelse in guards. 1281 Br = case Rs of 1282 [] -> return; 1283 _ -> {break,Rs} 1284 end, 1285 {B1,Bu,St1} = umatch(B0, Br, St0), 1286 {#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, 1287 vars=Vs,body=B1,ret=Rs},Bu,St1}; 1288uguard_expr(Lit, Rs, St) -> 1289 %% Transform literals to puts here. 1290 Used = lit_vars(Lit), 1291 {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, 1292 arg=Lit,ret=Rs},Used,St}. 1293 1294%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}. 1295%% Tag an expression with its used variables. 1296%% Break = return | {break,[RetVar]}. 1297 1298uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) -> 1299 Free = get_free(F, Ar, St), 1300 As1 = As0 ++ Free, %Add free variables LAST! 1301 Used = lit_list_vars(As1), 1302 {case Br of 1303 {break,Rs} -> 1304 Call#k_call{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}, 1305 op=Op#k_local{arity=Ar + length(Free)}, 1306 args=As1,ret=Rs}; 1307 return -> 1308 #k_enter{anno=#k{us=Used,ns=[],a=A}, 1309 op=Op#k_local{arity=Ar + length(Free)}, 1310 args=As1} 1311 end,Used,St}; 1312uexpr(#k_call{anno=A,op=Op,args=As}=Call, {break,Rs}, St) -> 1313 Used = union(op_vars(Op), lit_list_vars(As)), 1314 {Call#k_call{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs}, 1315 Used,St}; 1316uexpr(#k_call{anno=A,op=Op,args=As}, return, St) -> 1317 Used = union(op_vars(Op), lit_list_vars(As)), 1318 {#k_enter{anno=#k{us=Used,ns=[],a=A},op=Op,args=As}, 1319 Used,St}; 1320uexpr(#k_bif{anno=A,op=Op,args=As}=Bif, {break,Rs}, St0) -> 1321 Used = union(op_vars(Op), lit_list_vars(As)), 1322 {Brs,St1} = bif_returns(Op, Rs, St0), 1323 {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Brs),a=A},ret=Brs}, 1324 Used,St1}; 1325uexpr(#k_match{anno=A,vars=Vs,body=B0}, Br, St0) -> 1326 Rs = break_rets(Br), 1327 {B1,Bu,St1} = umatch(B0, Br, St0), 1328 {#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, 1329 vars=Vs,body=B1,ret=Rs},Bu,St1}; 1330uexpr(#k_receive{anno=A,var=V,body=B0,timeout=T,action=A0}, Br, St0) -> 1331 Rs = break_rets(Br), 1332 Tu = lit_vars(T), %Timeout is atomic 1333 {B1,Bu,St1} = umatch(B0, Br, St0), 1334 {A1,Au,St2} = ubody(A0, Br, St1), 1335 Used = del_element(V#k_var.name, union(Bu, union(Tu, Au))), 1336 {#k_receive{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}, 1337 var=V,body=B1,timeout=T,action=A1,ret=Rs}, 1338 Used,St2}; 1339uexpr(#k_receive_accept{anno=A}, _, St) -> 1340 {#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St}; 1341uexpr(#k_receive_next{anno=A}, _, St) -> 1342 {#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St}; 1343uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, 1344 {break,Rs0}, St0) -> 1345 {Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here 1346 {A1,Au,St2} = ubody(A0, {break,Avs}, St1), %Must break to clean up here! 1347 {B1,Bu,St3} = ubody(B0, {break,Rs0}, St2), 1348 {H1,Hu,St4} = ubody(H0, {break,Rs0}, St3), 1349 %% Guarantee ONE return variable. 1350 NumNew = if 1351 Rs0 =:= [] -> 1; 1352 true -> 0 1353 end, 1354 {Ns,St5} = new_vars(NumNew, St4), 1355 Rs1 = Rs0 ++ Ns, 1356 Used = union([Au,subtract(Bu, lit_list_vars(Vs)), 1357 subtract(Hu, lit_list_vars(Evs))]), 1358 {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A}, 1359 arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1}, 1360 Used,St5}; 1361uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> 1362 {Rb,St1} = new_var(St0), 1363 {B1,Bu,St2} = ubody(B0, {break,[Rb]}, St1), 1364 %% Guarantee ONE return variable. 1365 {Ns,St3} = new_vars(1 - length(Rs0), St2), 1366 Rs1 = Rs0 ++ Ns, 1367 {#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3}; 1368uexpr(#ifun{anno=A,vars=Vs,body=B0}=IFun, {break,Rs}, St0) -> 1369 {B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function 1370 Ns = lit_list_vars(Vs), 1371 Free = subtract(Bu, Ns), %Free variables in fun 1372 Fvs = make_vars(Free), 1373 Arity = length(Vs) + length(Free), 1374 {{Index,Uniq,Fname}, St3} = 1375 case lists:keysearch(id, 1, A) of 1376 {value,{id,Id}} -> 1377 {Id, St1}; 1378 false -> 1379 %% No id annotation. Must invent one. 1380 I = St1#kern.fcount, 1381 U = erlang:hash(IFun, (1 bsl 27)-1), 1382 {N, St2} = new_fun_name(St1), 1383 {{I,U,N}, St2} 1384 end, 1385 Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, 1386 vars=Vs ++ Fvs,body=B1}, 1387 {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, 1388 op=#k_internal{name=make_fun,arity=length(Free)+3}, 1389 args=[#k_atom{val=Fname},#k_int{val=Arity}, 1390 #k_int{val=Index},#k_int{val=Uniq}|Fvs], 1391 ret=Rs}, 1392% {#k_call{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, 1393% op=#k_internal{name=make_fun,arity=length(Free)+3}, 1394% args=[#k_atom{val=Fname},#k_int{val=Arity}, 1395% #k_int{val=Index},#k_int{val=Uniq}|Fvs], 1396% ret=Rs}, 1397 Free,St3#kern{funs=[Fun|St3#kern.funs]}}; 1398uexpr(Lit, {break,Rs}, St) -> 1399 %% Transform literals to puts here. 1400 %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), 1401 Used = lit_vars(Lit), 1402 {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, 1403 arg=Lit,ret=Rs},Used,St}. 1404 1405%% get_free(Name, Arity, State) -> [Free]. 1406%% store_free(Name, Arity, [Free], State) -> State. 1407 1408get_free(F, A, St) -> 1409 case orddict:find({F,A}, St#kern.free) of 1410 {ok,Val} -> Val; 1411 error -> [] 1412 end. 1413 1414store_free(F, A, Free, St) -> 1415 St#kern{free=orddict:store({F,A}, Free, St#kern.free)}. 1416 1417break_rets({break,Rs}) -> Rs; 1418break_rets(return) -> []. 1419 1420%% bif_returns(Op, [Ret], State) -> {[Ret],State}. 1421 1422bif_returns(#k_remote{mod=M,name=N,arity=Ar}, Rs, St0) -> 1423 %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,{M,N,Ar,Rs}]), 1424 {Ns,St1} = new_vars(bif_vals(M, N, Ar) - length(Rs), St0), 1425 {Rs ++ Ns,St1}; 1426bif_returns(#k_internal{name=N,arity=Ar}, Rs, St0) -> 1427 %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,{N,Ar,Rs}]), 1428 {Ns,St1} = new_vars(bif_vals(N, Ar) - length(Rs), St0), 1429 {Rs ++ Ns,St1}. 1430 1431%% umatch(Match, Break, State) -> {Match,[UsedVar],State}. 1432%% Tag a match expression with its used variables. 1433 1434umatch(#k_alt{anno=A,first=F0,then=T0}, Br, St0) -> 1435 {F1,Fu,St1} = umatch(F0, Br, St0), 1436 {T1,Tu,St2} = umatch(T0, Br, St1), 1437 Used = union(Fu, Tu), 1438 {#k_alt{anno=#k{us=Used,ns=[],a=A},first=F1,then=T1}, 1439 Used,St2}; 1440umatch(#k_select{anno=A,var=V,types=Ts0}, Br, St0) -> 1441 {Ts1,Tus,St1} = umatch_list(Ts0, Br, St0), 1442 Used = add_element(V#k_var.name, Tus), 1443 {#k_select{anno=#k{us=Used,ns=[],a=A},var=V,types=Ts1},Used,St1}; 1444umatch(#k_type_clause{anno=A,type=T,values=Vs0}, Br, St0) -> 1445 {Vs1,Vus,St1} = umatch_list(Vs0, Br, St0), 1446 {#k_type_clause{anno=#k{us=Vus,ns=[],a=A},type=T,values=Vs1},Vus,St1}; 1447umatch(#k_val_clause{anno=A,val=P,body=B0}, Br, St0) -> 1448 {U0,Ps} = pat_vars(P), 1449 {B1,Bu,St1} = umatch(B0, Br, St0), 1450 Used = union(U0, subtract(Bu, Ps)), 1451 {#k_val_clause{anno=#k{us=Used,ns=[],a=A},val=P,body=B1}, 1452 Used,St1}; 1453umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) -> 1454 {Gs1,Gus,St1} = umatch_list(Gs0, Br, St0), 1455 {#k_guard{anno=#k{us=Gus,ns=[],a=A},clauses=Gs1},Gus,St1}; 1456umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) -> 1457 %%ok = io:fwrite("~w: ~p~n", [?LINE,G0]), 1458 {G1,Gu,St1} = uguard(G0, St0), 1459 %%ok = io:fwrite("~w: ~p~n", [?LINE,G1]), 1460 {B1,Bu,St2} = umatch(B0, Br, St1), 1461 Used = union(Gu, Bu), 1462 {#k_guard_clause{anno=#k{us=Used,ns=[],a=A},guard=G1,body=B1},Used,St2}; 1463umatch(B0, Br, St0) -> ubody(B0, Br, St0). 1464 1465umatch_list(Ms0, Br, St) -> 1466 foldr(fun (M0, {Ms1,Us,Sta}) -> 1467 {M1,Mu,Stb} = umatch(M0, Br, Sta), 1468 {[M1|Ms1],union(Mu, Us),Stb} 1469 end, {[],[],St}, Ms0). 1470 1471%% op_vars(Op) -> [VarName]. 1472 1473op_vars(#k_local{}) -> []; 1474op_vars(#k_remote{mod=Mod,name=Name}) -> 1475 ordsets:from_list([V || #k_var{name=V} <- [Mod,Name]]); 1476op_vars(#k_internal{}) -> []; 1477op_vars(Atomic) -> lit_vars(Atomic). 1478 1479%% lit_vars(Literal) -> [VarName]. 1480%% Return the variables in a literal. 1481 1482lit_vars(#k_var{name=N}) -> [N]; 1483lit_vars(#k_int{}) -> []; 1484lit_vars(#k_float{}) -> []; 1485lit_vars(#k_atom{}) -> []; 1486%%lit_vars(#k_char{}) -> []; 1487lit_vars(#k_string{}) -> []; 1488lit_vars(#k_nil{}) -> []; 1489lit_vars(#k_cons{hd=H,tl=T}) -> 1490 union(lit_vars(H), lit_vars(T)); 1491lit_vars(#k_binary{segs=V}) -> lit_vars(V); 1492lit_vars(#k_bin_end{}) -> []; 1493lit_vars(#k_bin_seg{size=Size,seg=S,next=N}) -> 1494 union(lit_vars(Size), union(lit_vars(S), lit_vars(N))); 1495lit_vars(#k_tuple{es=Es}) -> 1496 lit_list_vars(Es). 1497 1498lit_list_vars(Ps) -> 1499 foldl(fun (P, Vs) -> union(lit_vars(P), Vs) end, [], Ps). 1500 1501%% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}. 1502%% Return variables in a pattern. All variables are new variables 1503%% except those in the size field of binary segments. 1504 1505pat_vars(#k_var{name=N}) -> {[],[N]}; 1506%%pat_vars(#k_char{}) -> {[],[]}; 1507pat_vars(#k_int{}) -> {[],[]}; 1508pat_vars(#k_float{}) -> {[],[]}; 1509pat_vars(#k_atom{}) -> {[],[]}; 1510pat_vars(#k_string{}) -> {[],[]}; 1511pat_vars(#k_nil{}) -> {[],[]}; 1512pat_vars(#k_cons{hd=H,tl=T}) -> 1513 pat_list_vars([H,T]); 1514pat_vars(#k_binary{segs=V}) -> 1515 pat_vars(V); 1516pat_vars(#k_bin_seg{size=Size,seg=S,next=N}) -> 1517 {U1,New} = pat_list_vars([S,N]), 1518 {[],U2} = pat_vars(Size), 1519 {union(U1, U2),New}; 1520pat_vars(#k_bin_end{}) -> {[],[]}; 1521pat_vars(#k_tuple{es=Es}) -> 1522 pat_list_vars(Es). 1523 1524pat_list_vars(Ps) -> 1525 foldl(fun (P, {Used0,New0}) -> 1526 {Used,New} = pat_vars(P), 1527 {union(Used0, Used),union(New0, New)} end, 1528 {[],[]}, Ps). 1529 1530%% aligned(Bits, Size, Unit, Flags) -> {Size,Flags} 1531%% Add 'aligned' to the flags if the current field is aligned. 1532%% Number of bits correct modulo 8. 1533 1534aligned(B, S, U, Fs) when B rem 8 =:= 0 -> 1535 {incr_bits(B, S, U),[aligned|Fs]}; 1536aligned(B, S, U, Fs) -> 1537 {incr_bits(B, S, U),Fs}. 1538 1539incr_bits(B, #k_int{val=S}, U) when integer(B) -> B + S*U; 1540incr_bits(_, #k_atom{val=all}, _) -> 0; %Always aligned 1541incr_bits(B, _, 8) -> B; 1542incr_bits(_, _, _) -> unknown. 1543 1544make_list(Es) -> 1545 foldr(fun (E, Acc) -> #c_cons{hd=E,tl=Acc} end, #c_nil{}, Es). 1546 1547%% List of integers in interval [N,M]. Empty list if N > M. 1548 1549integers(N, M) when N =< M -> 1550 [N|integers(N + 1, M)]; 1551integers(_, _) -> []. 1552 1553%%% 1554%%% Handling of warnings. 1555%%% 1556 1557format_error({nomatch_shadow,Line}) -> 1558 M = io_lib:format("this clause cannot match because a previous clause at line ~p " 1559 "always matches", [Line]), 1560 lists:flatten(M); 1561format_error(nomatch_shadow) -> 1562 "this clause cannot match because a previous clause always matches". 1563 1564add_warning(none, Term, #kern{ws=Ws}=St) -> 1565 St#kern{ws=[{?MODULE,Term}|Ws]}; 1566add_warning(Line, Term, #kern{ws=Ws}=St) when Line >= 0 -> 1567 St#kern{ws=[{Line,?MODULE,Term}|Ws]}; 1568add_warning(_, _, St) -> St. 1569