1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1999-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20%% Purpose : Transform Core Erlang to Kernel Erlang
21
22%% Kernel erlang is like Core Erlang with a few significant
23%% differences:
24%%
25%% 1. It is flat!  There are no nested calls or sub-blocks.
26%%
27%% 2. All variables are unique in a function.  There is no scoping, or
28%% rather the scope is the whole function.
29%%
30%% 3. Pattern matching (in cases and receives) has been compiled.
31%%
32%% 4. All remote-calls are to statically named m:f/a. Meta-calls are
33%% passed via erlang:apply/3.
34%%
35%% The translation is done in two passes:
36%%
37%% 1. Basic translation, translate variable/function names, flatten
38%% completely, pattern matching compilation.
39%%
40%% 2. Fun-lifting (lambda-lifting), variable usage annotation and
41%% last-call handling.
42%%
43%% All new Kexprs are created in the first pass, they are just
44%% annotated in the second.
45%%
46%% Functions and BIFs
47%%
48%% Functions are "call"ed or "enter"ed if it is a last call, their
49%% return values may be ignored.  BIFs are things which are known to
50%% be internal by the compiler and can only be called, their return
51%% values cannot be ignored.
52%%
53%% Letrec's are handled rather naively.  All the functions in one
54%% letrec are handled as one block to find the free variables.  While
55%% this is not optimal it reflects how letrec's often are used.  We
56%% don't have to worry about variable shadowing and nested letrec's as
57%% this is handled in the variable/function name translation.  There
58%% is a little bit of trickery to ensure letrec transformations fit
59%% into the scheme of things.
60%%
61%% To ensure unique variable names we use a variable substitution
62%% table and keep the set of all defined variables.  The nested
63%% scoping of Core means that we must also nest the substitution
64%% tables, but the defined set must be passed through to match the
65%% flat structure of Kernel and to make sure variables with the same
66%% name from different scopes get different substitutions.
67%%
68%% We also use these substitutions to handle the variable renaming
69%% necessary in pattern matching compilation.
70%%
71%% The pattern matching compilation assumes that the values of
72%% different types don't overlap.  This means that as there is no
73%% character type yet in the machine all characters must be converted
74%% to integers!
75
76-module(v3_kernel).
77
78-export([module/2,format_error/1]).
79
80-import(lists, [all/2,droplast/1,flatten/1,foldl/3,foldr/3,
81                map/2,mapfoldl/3,member/2,
82		keyfind/3,keyreplace/4,
83                last/1,partition/2,reverse/1,
84                sort/1,sort/2,splitwith/2]).
85-import(ordsets, [add_element/2,intersection/2,
86                  subtract/2,union/2,union/1]).
87
88-include("core_parse.hrl").
89-include("v3_kernel.hrl").
90
91%% Matches collapse max segment in v3_core.
92-define(EXPAND_MAX_SIZE_SEGMENT, 1024).
93
94%% These are not defined in v3_kernel.hrl.
95get_kanno(Kthing) -> element(2, Kthing).
96set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno).
97copy_anno(Kdst, Ksrc) ->
98    Anno = get_kanno(Ksrc),
99    set_kanno(Kdst, Anno).
100
101%% Internal kernel expressions and help functions.
102%% N.B. the annotation field is ALWAYS the first field!
103
104-record(ivalues, {anno=[],args}).
105-record(ifun, {anno=[],vars,body}).
106-record(iset, {anno=[],vars,arg,body}).
107-record(iletrec, {anno=[],defs}).
108-record(ialias, {anno=[],vars,pat}).
109-record(iclause, {anno=[],isub,osub,pats,guard,body}).
110
111-type warning() :: term().	% XXX: REFINE
112
113%% State record for kernel translator.
114-record(kern, {func,				%Current host function
115               fargs=[] :: [#k_var{}],          %Arguments for current function
116	       vcount=0,			%Variable counter
117	       fcount=0,			%Fun counter
118               ds=sets:new([{version, 2}]) :: sets:set(), %Defined variables
119	       funs=[],				%Fun functions
120	       free=#{},			%Free variables
121	       ws=[]   :: [warning()],		%Warnings.
122               no_shared_fun_wrappers=false :: boolean(),
123               labels=sets:new([{version, 2}])
124              }).
125
126-spec module(cerl:c_module(), [compile:option()]) ->
127	{'ok', #k_mdef{}, [warning()]}.
128
129module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) ->
130    Kas = attributes(As),
131    Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es),
132    NoSharedFunWrappers = proplists:get_bool(no_shared_fun_wrappers,
133                                             Options),
134    St0 = #kern{no_shared_fun_wrappers=NoSharedFunWrappers},
135    {Kfs,St} = mapfoldl(fun function/2, St0, Fs),
136    {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
137                body=Kfs ++ St#kern.funs},sort(St#kern.ws)}.
138
139attributes([{#c_literal{val=Name},#c_literal{val=Val}}|As]) ->
140    case include_attribute(Name) of
141	false ->
142	    attributes(As);
143	true ->
144	    [{Name,Val}|attributes(As)]
145    end;
146attributes([]) -> [].
147
148include_attribute(type) -> false;
149include_attribute(spec) -> false;
150include_attribute(callback) -> false;
151include_attribute(opaque) -> false;
152include_attribute(export_type) -> false;
153include_attribute(record) -> false;
154include_attribute(optional_callbacks) -> false;
155include_attribute(file) -> false;
156include_attribute(compile) -> false;
157include_attribute(_) -> true.
158
159function({#c_var{name={F,Arity}=FA},Body}, St0) ->
160    %%io:format("~w/~w~n", [F,Arity]),
161    try
162        %% Find a suitable starting value for the variable counter. Note
163        %% that this pass assumes that new_var_name/1 returns a variable
164        %% name distinct from any variable used in the entire body of
165        %% the function. We use integers as variable names to avoid
166        %% filling up the atom table when compiling huge functions.
167        Count = cerl_trees:next_free_variable_name(Body),
168	St1 = St0#kern{func=FA,vcount=Count,fcount=0,ds=sets:new([{version, 2}])},
169	{#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1),
170	{B1,_,St3} = ubody(B0, return, St2),
171	%%B1 = B0, St3 = St2,				%Null second pass
172        {make_fdef(Ab, F, Arity, Kvs, B1),St3}
173    catch
174        Class:Error:Stack ->
175	    io:fwrite("Function: ~w/~w\n", [F,Arity]),
176	    erlang:raise(Class, Error, Stack)
177    end.
178
179%% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}.
180%%  Do the main sequence of a body.  A body ends in an atomic value or
181%%  values.  Must check if vector first so do expr.
182
183body(#c_values{anno=A,es=Ces}, Sub, St0) ->
184    %% Do this here even if only in bodies.
185    {Kes,Pe,St1} = atomic_list(Ces, Sub, St0),
186    {#ivalues{anno=A,args=Kes},Pe,St1};
187body(Ce, Sub, St0) ->
188    expr(Ce, Sub, St0).
189
190%% guard(Cexpr, Sub, State) -> {Kexpr,State}.
191%%  We handle guards almost as bodies. The only special thing we
192%%  must do is to make the final Kexpr a #k_test{}.
193
194guard(G0, Sub, St0) ->
195    {Ge0,Pre,St1} = expr(G0, Sub, St0),
196    {Ge,St} = gexpr_test(Ge0, St1),
197    {pre_seq(Pre, Ge),St}.
198
199%% gexpr_test(Kexpr, State) -> {Kexpr,State}.
200%%  Builds the final boolean test from the last Kexpr in a guard test.
201%%  Must enter try blocks and isets and find the last Kexpr in them.
202%%  This must end in a recognised BEAM test!
203
204gexpr_test(#k_bif{anno=A,
205                  op=#k_remote{mod=#k_literal{val=erlang},
206                               name=#k_literal{val=F},arity=Ar}=Op,
207		  args=Kargs}=Ke, St) ->
208    %% Either convert to test if ok, or add test.
209    %% At this stage, erlang:float/1 is not a type test. (It should
210    %% have been converted to erlang:is_float/1.)
211    case erl_internal:new_type_test(F, Ar) orelse
212	erl_internal:comp_op(F, Ar) of
213	true -> {#k_test{anno=A,op=Op,args=Kargs},St};
214	false -> gexpr_test_add(Ke, St)		%Add equality test
215    end;
216gexpr_test(#k_try{arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X},
217		  handler=#k_literal{val=false}}=Try, St0) ->
218    {B,St} = gexpr_test(B0, St0),
219    %%ok = io:fwrite("~w: ~p~n", [?LINE,{B0,B}]),
220    {Try#k_try{arg=B},St};
221gexpr_test(#iset{body=B0}=Iset, St0) ->
222    {B1,St1} = gexpr_test(B0, St0),
223    {Iset#iset{body=B1},St1};
224gexpr_test(Ke, St) -> gexpr_test_add(Ke, St).	%Add equality test
225
226gexpr_test_add(Ke, St0) ->
227    Test = #k_remote{mod=#k_literal{val='erlang'},
228		     name=#k_literal{val='=:='},
229		     arity=2},
230    {Ae,Ap,St1} = force_atomic(Ke, St0),
231    {pre_seq(Ap, #k_test{anno=get_kanno(Ke),
232			 op=Test,args=[Ae,#k_literal{val='true'}]}),St1}.
233
234%% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}.
235%%  Convert a Core expression, flattening it at the same time.
236
237expr(#c_var{anno=A0,name={Name,Arity}}=Fname, Sub, St) ->
238    Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} ||
239             V <- integers(1, Arity)],
240    case St#kern.no_shared_fun_wrappers of
241        false ->
242            %% Generate a (possibly shared) wrapper function for calling
243            %% this function.
244            Wrapper0 = ["-fun.",atom_to_list(Name),"/",integer_to_list(Arity),"-"],
245            Wrapper = list_to_atom(flatten(Wrapper0)),
246            Id = {id,{0,0,Wrapper}},
247            A = keyreplace(id, 1, A0, Id),
248            Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}},
249            expr(Fun, Sub, St);
250        true ->
251            %% For backward compatibility with OTP 22 and earlier,
252            %% use the pre-generated name for the fun wrapper.
253            %% There will be one wrapper function for each occurrence
254            %% of `fun F/A`.
255            Fun = #c_fun{anno=A0,vars=Vs,body=#c_apply{anno=A0,op=Fname,args=Vs}},
256            expr(Fun, Sub, St)
257    end;
258expr(#c_var{anno=A,name=V}, Sub, St) ->
259    {#k_var{anno=A,name=get_vsub(V, Sub)},[],St};
260expr(#c_literal{anno=A,val=V}, _Sub, St) ->
261    {#k_literal{anno=A,val=V},[],St};
262expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) ->
263    %% Do cons in two steps, first the expressions left to right, then
264    %% any remaining literals right to left.
265    {Kh0,Hp0,St1} = expr(Ch, Sub, St0),
266    {Kt0,Tp0,St2} = expr(Ct, Sub, St1),
267    {Kt1,Tp1,St3} = force_atomic(Kt0, St2),
268    {Kh1,Hp1,St4} = force_atomic(Kh0, St3),
269    {#k_cons{anno=A,hd=Kh1,tl=Kt1},Hp0 ++ Tp0 ++ Tp1 ++ Hp1,St4};
270expr(#c_tuple{anno=A,es=Ces}, Sub, St0) ->
271    {Kes,Ep,St1} = atomic_list(Ces, Sub, St0),
272    {#k_tuple{anno=A,es=Kes},Ep,St1};
273expr(#c_map{anno=A,arg=Var,es=Ces}, Sub, St0) ->
274    expr_map(A, Var, Ces, Sub, St0);
275expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
276    try atomic_bin(Cv, Sub, St0) of
277	{Kv,Ep,St1} ->
278	    {#k_binary{anno=A,segs=Kv},Ep,St1}
279    catch
280	throw:{bad_segment_size,Location} ->
281	    St1 = add_warning(Location, {failed,bad_segment_size}, A, St0),
282	    Erl = #c_literal{val=erlang},
283	    Name = #c_literal{val=error},
284	    Args = [#c_literal{val=badarg}],
285	    Error = #c_call{anno=A,module=Erl,name=Name,args=Args},
286	    expr(Error, Sub, St1)
287    end;
288expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0,
289     #kern{fargs=OldFargs}=St0) ->
290    {Kvs,Sub1,St1} = pattern_list(Cvs, Sub0, St0),
291    %%ok = io:fwrite("~w: ~p~n", [?LINE,{{Cvs,Sub0,St0},{Kvs,Sub1,St1}}]),
292    {Kb,Pb,St2} = body(Cb, Sub1, St1#kern{fargs=Kvs}),
293    {#ifun{anno=A,vars=Kvs,body=pre_seq(Pb, Kb)},[],St2#kern{fargs=OldFargs}};
294expr(#c_seq{arg=Ca,body=Cb}, Sub, St0) ->
295    {Ka,Pa,St1} = body(Ca, Sub, St0),
296    {Kb,Pb,St2} = body(Cb, Sub, St1),
297    {Kb,Pa ++ [Ka] ++ Pb,St2};
298expr(#c_let{anno=A,vars=Cvs,arg=Ca,body=Cb}, Sub0, St0) ->
299    %%ok = io:fwrite("~w: ~p~n", [?LINE,{Cvs,Sub0,St0}]),
300    {Ka,Pa,St1} = body(Ca, Sub0, St0),
301    {Kps,Sub1,St2} = pattern_list(Cvs, Sub0, St1),
302    %%ok = io:fwrite("~w: ~p~n", [?LINE,{Kps,Sub1,St1,St2}]),
303    %% Break known multiple values into separate sets.
304    Sets = case Ka of
305	       #ivalues{args=Kas} ->
306		   foldr2(fun (V, Val, Sb) ->
307				  [#iset{vars=[V],arg=Val}|Sb] end,
308			  [], Kps, Kas);
309	       _Other ->
310		   [#iset{anno=A,vars=Kps,arg=Ka}]
311	   end,
312    {Kb,Pb,St3} = body(Cb, Sub1, St2),
313    {Kb,Pa ++ Sets ++ Pb,St3};
314expr(#c_letrec{anno=A,defs=Cfs,body=Cb}, Sub, St) ->
315    case member(letrec_goto, A) of
316        true ->
317            letrec_goto(Cfs, Cb, Sub, St);
318        false ->
319            letrec_local_function(A, Cfs, Cb, Sub, St)
320    end;
321expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) ->
322    {Ka,Pa,St1} = body(Ca, Sub, St0),		%This is a body!
323    {Kvs,Pv,St2} = match_vars(Ka, St1),		%Must have variables here!
324    {Km,St3} = kmatch(Kvs, Ccs, Sub, St2),
325    Match = flatten_seq(build_match(Km)),
326    {last(Match),Pa ++ Pv ++ droplast(Match),St3};
327expr(#c_apply{anno=A,op=Cop,args=Cargs}, Sub, St) ->
328    c_apply(A, Cop, Cargs, Sub, St);
329expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) ->
330    Ar = length(Cargs),
331    {[M,F|Kargs],Ap,St1} = atomic_list([M0,F0|Cargs], Sub, St0),
332    Remote = #k_remote{mod=M,name=F,arity=Ar},
333    case call_type(M0, F0, Cargs) of
334        bif ->
335            {#k_bif{anno=A,op=Remote,args=Kargs},Ap,St1};
336        call ->
337            {#k_call{anno=A,op=Remote,args=Kargs},Ap,St1};
338        error ->
339            %% Invalid call (e.g. M:42/3). Issue a warning, and let
340            %% the generated code use the old explict apply.
341            St = add_warning(get_location(A), {failed,bad_call}, A, St0),
342	    Call = #c_call{anno=A,
343			   module=#c_literal{val=erlang},
344			   name=#c_literal{val=apply},
345			   args=[M0,F0,cerl:make_list(Cargs)]},
346	    expr(Call, Sub, St)
347    end;
348expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=[Arg]}, Sub, St) ->
349    translate_match_fail(Arg, Sub, A, St);
350expr(#c_primop{anno=A,name=#c_literal{val=N},args=Cargs}, Sub, St0) ->
351    {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0),
352    Ar = length(Cargs),
353    {#k_bif{anno=A,op=#k_internal{name=N,arity=Ar},args=Kargs},Ap,St1};
354expr(#c_try{anno=A,arg=Ca,vars=Cvs,body=Cb,evars=Evs,handler=Ch}, Sub0, St0) ->
355    %% The normal try expression. The body and exception handler
356    %% variables behave as let variables.
357    {Ka,Pa,St1} = body(Ca, Sub0, St0),
358    {Kcvs,Sub1,St2} = pattern_list(Cvs, Sub0, St1),
359    {Kb,Pb,St3} = body(Cb, Sub1, St2),
360    {Kevs,Sub2,St4} = pattern_list(Evs, Sub0, St3),
361    {Kh,Ph,St5} = body(Ch, Sub2, St4),
362    {#k_try{anno=A,arg=pre_seq(Pa, Ka),
363	    vars=Kcvs,body=pre_seq(Pb, Kb),
364	    evars=Kevs,handler=pre_seq(Ph, Kh)},[],St5};
365expr(#c_catch{anno=A,body=Cb}, Sub, St0) ->
366    {Kb,Pb,St1} = body(Cb, Sub, St0),
367    {#k_catch{anno=A,body=pre_seq(Pb, Kb)},[],St1}.
368
369%% Implement letrec in the traditional way as a local
370%% function for each definition in the letrec.
371
372letrec_local_function(A, Cfs, Cb, Sub0, St0) ->
373    %% Make new function names and store substitution.
374    {Fs0,{Sub1,St1}} =
375	mapfoldl(fun ({#c_var{name={F,Ar}},B0}, {Sub,S0}) ->
376			 {N,St1} = new_fun_name(atom_to_list(F)
377						++ "/" ++
378						integer_to_list(Ar),
379						S0),
380			 B = set_kanno(B0, [{letrec_name,N}]),
381			 {{N,B},{set_fsub(F, Ar, N, Sub),St1}}
382		 end, {Sub0,St0}, Cfs),
383    %% Run translation on functions and body.
384    {Fs1,St2} = mapfoldl(fun ({N,Fd0}, S1) ->
385				 {Fd1,[],St2} = expr(Fd0, Sub1, S1),
386				 Fd = set_kanno(Fd1, A),
387				 {{N,Fd},St2}
388			 end, St1, Fs0),
389    {Kb,Pb,St3} = body(Cb, Sub1, St2),
390    {Kb,[#iletrec{anno=A,defs=Fs1}|Pb],St3}.
391
392%% Implement letrec with the single definition as a label and each
393%% apply of it as a goto.
394
395letrec_goto([{#c_var{name={Label,0}},Cfail}], Cb, Sub0,
396            #kern{labels=Labels0}=St0) ->
397    Labels = sets:add_element(Label, Labels0),
398    {Kb,Pb,St1} = body(Cb, Sub0, St0#kern{labels=Labels}),
399    #c_fun{body=FailBody} = Cfail,
400    {Kfail,Fb,St2} = body(FailBody, Sub0, St1),
401    case {Kb,Kfail,Fb} of
402        {#k_goto{label=Label},#k_goto{}=InnerGoto,[]} ->
403            {InnerGoto,Pb,St2};
404        {_,_,_} ->
405            St3 = St2#kern{labels=Labels0},
406            Alt = #k_letrec_goto{label=Label,first=Kb,then=pre_seq(Fb, Kfail)},
407            {Alt,Pb,St3}
408    end.
409
410%% translate_match_fail(Arg, Sub, Anno, St) -> {Kexpr,[PreKexpr],State}.
411%%  Translate a match_fail primop to a call erlang:error/1 or
412%%  erlang:error/2.
413
414translate_match_fail(Arg, Sub, Anno, St0) ->
415    Cargs = case {cerl:data_type(Arg),cerl:data_es(Arg)} of
416                {tuple,[#c_literal{val=function_clause}|As]} ->
417                    translate_fc_args(As, Sub, St0);
418                {_,_} ->
419                    [Arg]
420            end,
421    {Kargs,Ap,St} = atomic_list(Cargs, Sub, St0),
422    Ar = length(Cargs),
423    Call = #k_call{anno=Anno,
424                   op=#k_remote{mod=#k_literal{val=erlang},
425                                name=#k_literal{val=error},
426                                arity=Ar},args=Kargs},
427    {Call,Ap,St}.
428
429translate_fc_args(As, Sub, #kern{fargs=Fargs}) ->
430    case same_args(As, Fargs, Sub) of
431        true ->
432            %% The arguments for the `function_clause` exception are
433            %% the arguments for the current function in the correct
434            %% order.
435            [#c_literal{val=function_clause},cerl:make_list(As)];
436        false ->
437            %% The arguments in the `function_clause` exception don't
438            %% match the arguments for the current function because
439            %% of inlining. Keeping the `function_clause`
440            %% exception reason would be confusing. Rewrite it to
441            %% a `case_clause` exception with the arguments in a
442            %% tuple.
443	    [cerl:c_tuple([#c_literal{val=case_clause},
444                           cerl:c_tuple(As)])]
445    end.
446
447same_args([#c_var{name=Cv}|Vs], [#k_var{name=Kv}|As], Sub) ->
448    get_vsub(Cv, Sub) =:= Kv andalso same_args(Vs, As, Sub);
449same_args([], [], _Sub) -> true;
450same_args(_, _, _) -> false.
451
452expr_map(A,Var0,Ces,Sub,St0) ->
453    {Var,Mps,St1} = expr(Var0, Sub, St0),
454    {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1),
455    {Km,Eps++Mps,St2}.
456
457map_split_pairs(A, Var, Ces, Sub, St0) ->
458    %% 1. Force variables.
459    %% 2. Group adjacent pairs with literal keys.
460    %% 3. Within each such group, remove multiple assignments to the same key.
461    %% 4. Partition each group according to operator ('=>' and ':=').
462    Pairs0 = [{Op,K,V} ||
463		 #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces],
464    {Pairs,Esp,St1} = foldr(fun
465	    ({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact ->
466		{K,Eps1,Sti1} = atomic(K0, Sub, Sti0),
467		{V,Eps2,Sti2} = atomic(V0, Sub, Sti1),
468		{[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ Espi,Sti2}
469	end, {[],[],St0}, Pairs0),
470    map_split_pairs_1(A, Var, Pairs, Esp, St1).
471
472map_split_pairs_1(A, Map0, [{Op,Key,Val}|Pairs1]=Pairs0, Esp0, St0) ->
473    {Map1,Em,St1} = force_atomic(Map0, St0),
474    case Key of
475	#k_var{} ->
476	    %% Don't combine variable keys with other keys.
477	    Kes = [#k_map_pair{key=Key,val=Val}],
478	    Map = #k_map{anno=A,op=Op,var=Map1,es=Kes},
479	    map_split_pairs_1(A, Map, Pairs1, Esp0 ++ Em, St1);
480	_ ->
481	    %% Literal key. Split off all literal keys.
482	    {L,Pairs} = splitwith(fun({_,#k_var{},_}) -> false;
483				     ({_,_,_}) -> true
484				  end, Pairs0),
485	    {Map,Esp,St2} = map_group_pairs(A, Map1, L, Esp0 ++ Em, St1),
486	    map_split_pairs_1(A, Map, Pairs, Esp, St2)
487    end;
488map_split_pairs_1(_, Map, [], Esp, St0) ->
489    {Map,Esp,St0}.
490
491map_group_pairs(A, Var, Pairs0, Esp, St0) ->
492    Pairs = map_remove_dup_keys(Pairs0),
493    Assoc = [#k_map_pair{key=K,val=V} || {_,{assoc,K,V}} <- Pairs],
494    Exact = [#k_map_pair{key=K,val=V} || {_,{exact,K,V}} <- Pairs],
495    case {Assoc,Exact} of
496	{[_|_],[]} ->
497	    {#k_map{anno=A,op=assoc,var=Var,es=Assoc},Esp,St0};
498	{[],[_|_]} ->
499	    {#k_map{anno=A,op=exact,var=Var,es=Exact},Esp,St0};
500	{[_|_],[_|_]} ->
501	    Map = #k_map{anno=A,op=assoc,var=Var,es=Assoc},
502	    {Mvar,Em,St1} = force_atomic(Map, St0),
503	    {#k_map{anno=A,op=exact,var=Mvar,es=Exact},Esp ++ Em,St1}
504    end.
505
506map_remove_dup_keys(Es) ->
507    map_remove_dup_keys(Es, #{}).
508
509map_remove_dup_keys([{assoc,K0,V}|Es0], Used0) ->
510    K = map_key_clean(K0),
511    Op = case Used0 of
512             #{K:={exact,_,_}} -> exact;
513             #{} -> assoc
514         end,
515    Used1 = Used0#{K=>{Op,K0,V}},
516    map_remove_dup_keys(Es0, Used1);
517map_remove_dup_keys([{exact,K0,V}|Es0], Used0) ->
518    K = map_key_clean(K0),
519    Op = case Used0 of
520             #{K:={assoc,_,_}} -> assoc;
521             #{} -> exact
522         end,
523    Used1 = Used0#{K=>{Op,K0,V}},
524    map_remove_dup_keys(Es0, Used1);
525map_remove_dup_keys([], Used) ->
526    %% We must sort the map entries to ensure consistent
527    %% order from compilation to compilation.
528    sort(maps:to_list(Used)).
529
530%% Clean a map key from annotations.
531map_key_clean(#k_var{name=V})    -> {var,V};
532map_key_clean(#k_literal{val=V}) -> {lit,V}.
533
534%% call_type(Module, Function, Arity) -> call | bif | error.
535%%  Classify the call.
536call_type(#c_literal{val=M}, #c_literal{val=F}, As) when is_atom(M), is_atom(F) ->
537    case is_remote_bif(M, F, As) of
538	false -> call;
539	true -> bif
540    end;
541call_type(#c_var{}, #c_literal{val=A}, _) when is_atom(A) -> call;
542call_type(#c_literal{val=A}, #c_var{}, _) when is_atom(A) -> call;
543call_type(#c_var{}, #c_var{}, _) -> call;
544call_type(_, _, _) -> error.
545
546%% match_vars(Kexpr, State) -> {[Kvar],[PreKexpr],State}.
547%%  Force return from body into a list of variables.
548
549match_vars(#ivalues{args=As}, St) ->
550    foldr(fun (Ka, {Vs,Vsp,St0}) ->
551		  {V,Vp,St1} = force_variable(Ka, St0),
552		  {[V|Vs],Vp ++ Vsp,St1}
553	  end, {[],[],St}, As);
554match_vars(Ka, St0) ->
555    {V,Vp,St1} = force_variable(Ka, St0),
556    {[V],Vp,St1}.
557
558%% c_apply(A, Op, [Carg], Sub, State) -> {Kexpr,[PreKexpr],State}.
559%%  Transform application.
560
561c_apply(A, #c_var{anno=Ra,name={F0,Ar}}, Cargs, Sub, #kern{labels=Labels}=St0) ->
562    case Ar =:= 0 andalso sets:is_element(F0, Labels) of
563        true ->
564            %% This is a goto to a label in a letrec_goto construct.
565            {#k_goto{label=F0},[],St0};
566        false ->
567            {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0),
568            F1 = get_fsub(F0, Ar, Sub),         %Has it been rewritten
569            {#k_call{anno=A,op=#k_local{anno=Ra,name=F1,arity=Ar},args=Kargs},
570             Ap,St1}
571    end;
572c_apply(A, Cop, Cargs, Sub, St0) ->
573    {Kop,Op,St1} = variable(Cop, Sub, St0),
574    {Kargs,Ap,St2} = atomic_list(Cargs, Sub, St1),
575    {#k_call{anno=A,op=Kop,args=Kargs},Op ++ Ap,St2}.
576
577flatten_seq(#iset{anno=A,vars=Vs,arg=Arg,body=B}) ->
578    [#iset{anno=A,vars=Vs,arg=Arg}|flatten_seq(B)];
579flatten_seq(Ke) -> [Ke].
580
581pre_seq([#iset{anno=A,vars=Vs,arg=Arg,body=B}|Ps], K) ->
582    B = undefined,				%Assertion.
583    #iset{anno=A,vars=Vs,arg=Arg,body=pre_seq(Ps, K)};
584pre_seq([P|Ps], K) ->
585    #iset{vars=[],arg=P,body=pre_seq(Ps, K)};
586pre_seq([], K) -> K.
587
588%% atomic(Cexpr, Sub, State) -> {Katomic,[PreKexpr],State}.
589%%  Convert a Core expression making sure the result is an atomic
590%%  literal.
591
592atomic(Ce, Sub, St0) ->
593    {Ke,Kp,St1} = expr(Ce, Sub, St0),
594    {Ka,Ap,St2} = force_atomic(Ke, St1),
595    {Ka,Kp ++ Ap,St2}.
596
597force_atomic(Ke, St0) ->
598    case is_atomic(Ke) of
599	true -> {Ke,[],St0};
600	false ->
601	    {V,St1} = new_var(St0),
602	    {V,[#iset{vars=[V],arg=Ke}],St1}
603    end.
604
605atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0],
606	   Sub, St0) ->
607    {E,Ap1,St1} = atomic(E0, Sub, St0),
608    {S1,Ap2,St2} = atomic(S0, Sub, St1),
609    validate_bin_element_size(S1, A),
610    U1 = cerl:concrete(U0),
611    Fs1 = cerl:concrete(Fs0),
612    {Es,Ap3,St3} = atomic_bin(Es0, Sub, St2),
613    {#k_bin_seg{anno=A,size=S1,
614		unit=U1,
615		type=cerl:concrete(T),
616		flags=Fs1,
617		seg=E,next=Es},
618     Ap1++Ap2++Ap3,St3};
619atomic_bin([], _Sub, St) -> {#k_bin_end{},[],St}.
620
621validate_bin_element_size(#k_var{}, _Anno) -> ok;
622validate_bin_element_size(#k_literal{val=Val}, Anno) ->
623    case Val of
624        all -> ok;
625        undefined -> ok;
626        _ when is_integer(Val), Val >= 0 -> ok;
627        _ -> throw({bad_segment_size,get_location(Anno)})
628    end.
629
630%% atomic_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}.
631
632atomic_list(Ces, Sub, St) ->
633    foldr(fun (Ce, {Kes,Esp,St0}) ->
634		  {Ke,Ep,St1} = atomic(Ce, Sub, St0),
635		  {[Ke|Kes],Ep ++ Esp,St1}
636	  end, {[],[],St}, Ces).
637
638%% is_atomic(Kexpr) -> boolean().
639%%  Is a Kexpr atomic?
640
641is_atomic(#k_literal{}) -> true;
642is_atomic(#k_var{}) -> true;
643%%is_atomic(#k_char{}) -> true;			%No characters
644is_atomic(_) -> false.
645
646%% variable(Cexpr, Sub, State) -> {Kvar,[PreKexpr],State}.
647%%  Convert a Core expression making sure the result is a variable.
648
649variable(Ce, Sub, St0) ->
650    {Ke,Kp,St1} = expr(Ce, Sub, St0),
651    {Kv,Vp,St2} = force_variable(Ke, St1),
652    {Kv,Kp ++ Vp,St2}.
653
654force_variable(#k_var{}=Ke, St) -> {Ke,[],St};
655force_variable(Ke, St0) ->
656    {V,St1} = new_var(St0),
657    {V,[#iset{vars=[V],arg=Ke}],St1}.
658
659%% pattern(Cpat, Isub, Osub, State) -> {Kpat,Sub,State}.
660%%  Convert patterns.  Variables shadow so rename variables that are
661%%  already defined.
662%%
663%%  Patterns are complicated by sizes in binaries.  These are pure
664%%  input variables which create no bindings.  We, therefore, need to
665%%  carry around the original substitutions to get the correct
666%%  handling.
667
668pattern(#c_var{anno=A,name=V}, _Isub, Osub, St0) ->
669    case sets:is_element(V, St0#kern.ds) of
670	true ->
671	    {New,St1} = new_var_name(St0),
672	    {#k_var{anno=A,name=New},
673	     set_vsub(V, New, Osub),
674	     St1#kern{ds=sets:add_element(New, St1#kern.ds)}};
675	false ->
676	    {#k_var{anno=A,name=V},Osub,
677	     St0#kern{ds=sets:add_element(V, St0#kern.ds)}}
678    end;
679pattern(#c_literal{anno=A,val=Val}, _Isub, Osub, St) ->
680    {#k_literal{anno=A,val=Val},Osub,St};
681pattern(#c_cons{anno=A,hd=Ch,tl=Ct}, Isub, Osub0, St0) ->
682    {Kh,Osub1,St1} = pattern(Ch, Isub, Osub0, St0),
683    {Kt,Osub2,St2} = pattern(Ct, Isub, Osub1, St1),
684    {#k_cons{anno=A,hd=Kh,tl=Kt},Osub2,St2};
685pattern(#c_tuple{anno=A,es=Ces}, Isub, Osub0, St0) ->
686    {Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0),
687    {#k_tuple{anno=A,es=Kes},Osub1,St1};
688pattern(#c_map{anno=A,es=Ces}, Isub, Osub0, St0) ->
689    {Kes,Osub1,St1} = pattern_map_pairs(Ces, Isub, Osub0, St0),
690    {#k_map{anno=A,op=exact,es=Kes},Osub1,St1};
691pattern(#c_binary{anno=A,segments=Cv}, Isub, Osub0, St0) ->
692    {Kv,Osub1,St1} = pattern_bin(Cv, Isub, Osub0, St0),
693    {#k_binary{anno=A,segs=Kv},Osub1,St1};
694pattern(#c_alias{anno=A,var=Cv,pat=Cp}, Isub, Osub0, St0) ->
695    {Cvs,Cpat} = flatten_alias(Cp),
696    {Kvs,Osub1,St1} = pattern_list([Cv|Cvs], Isub, Osub0, St0),
697    {Kpat,Osub2,St2} = pattern(Cpat, Isub, Osub1, St1),
698    {#ialias{anno=A,vars=Kvs,pat=Kpat},Osub2,St2}.
699
700flatten_alias(#c_alias{var=V,pat=P}) ->
701    {Vs,Pat} = flatten_alias(P),
702    {[V|Vs],Pat};
703flatten_alias(Pat) -> {[],Pat}.
704
705pattern_map_pairs(Ces0, Isub, Osub0, St0) ->
706    %% pattern the pair keys and values as normal
707    {Kes,{Osub1,St1}} = mapfoldl(fun
708	    (#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) ->
709		{Kk,[],Sti1} = expr(Ck, Isub, Sti0),
710		{Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1),
711		{#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}}
712	end, {Osub0, St0}, Ces0),
713    %% It is later assumed that these keys are term sorted
714    %% so we need to sort them here
715    Kes1 = sort(fun
716	    (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) ->
717		A = map_key_clean(KkA),
718		B = map_key_clean(KkB),
719		erts_internal:cmp_term(A,B) < 0
720	end, Kes),
721    {Kes1,Osub1,St1}.
722
723pattern_bin(Es, Isub, Osub0, St) ->
724    pattern_bin_1(Es, Isub, Osub0, St).
725
726pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0],
727              Isub, Osub0, St0) ->
728    {S1,[],St1} = expr(S0, Isub, St0),
729    S = case S1 of
730	    #k_var{} -> S1;
731            #k_literal{val=Val} when is_integer(Val); is_atom(Val) -> S1;
732	    _ ->
733		%% Bad size (coming from an optimization or Core Erlang
734		%% source code) - replace it with a known atom because
735		%% a literal or bit syntax construction can cause further
736		%% problems.
737		#k_literal{val=bad_size}
738	end,
739    U = cerl:concrete(U0),
740    Fs = cerl:concrete(Fs0),
741    {E,Osub1,St2} = pattern(E0, Isub, Osub0, St1),
742    {Es,Osub,St3} = pattern_bin_1(Es0, Isub, Osub1, St2),
743    {build_bin_seg(A, S, U, cerl:concrete(T), Fs, E, Es),Osub,St3};
744pattern_bin_1([], _Isub, Osub, St) ->
745    {#k_bin_end{},Osub,St}.
746
747%% build_bin_seg(Anno, Size, Unit, Type, Flags, Seg, Next) -> #k_bin_seg{}.
748%%  This function normalizes literal integers with size > 8 and literal
749%%  utf8 segments into integers with size = 8 (and potentially an integer
750%%  with size less than 8 at the end). This is so further optimizations
751%%  have a normalized view of literal integers, allowing us to generate
752%%  more literals and group more clauses. Those integers may be "squeezed"
753%%  later into the largest integer possible.
754%%
755build_bin_seg(A, #k_literal{val=Bits} = Sz, U, integer=Type,
756              [unsigned,big]=Flags, #k_literal{val=Int}=Seg, Next) when is_integer(Bits) ->
757    Size = Bits * U,
758    case integer_fits_and_is_expandable(Int, Size) of
759	true -> build_bin_seg_integer_recur(A, Size, Int, Next);
760	false -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}
761    end;
762build_bin_seg(A, Sz, U, utf8=Type, [unsigned,big]=Flags, #k_literal{val=Utf8} = Seg, Next) ->
763    case utf8_fits(Utf8) of
764      {Int, Bits} -> build_bin_seg_integer_recur(A, Bits, Int, Next);
765      error -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}
766    end;
767build_bin_seg(A, Sz, U, Type, Flags, Seg, Next) ->
768    #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}.
769
770build_bin_seg_integer_recur(A, Bits, Val, Next) when Bits > 8 ->
771    NextBits = Bits - 8,
772    NextVal = Val band ((1 bsl NextBits) - 1),
773    Last = build_bin_seg_integer_recur(A, NextBits, NextVal, Next),
774    build_bin_seg_integer(A, 8, Val bsr NextBits, Last);
775
776build_bin_seg_integer_recur(A, Bits, Val, Next) ->
777    build_bin_seg_integer(A, Bits, Val, Next).
778
779build_bin_seg_integer(A, Bits, Val, Next) ->
780    Sz = #k_literal{anno=A,val=Bits},
781    Seg = #k_literal{anno=A,val=Val},
782    #k_bin_seg{anno=A,size=Sz,unit=1,type=integer,flags=[unsigned,big],seg=Seg,next=Next}.
783
784integer_fits_and_is_expandable(Int, Size) when is_integer(Int), is_integer(Size),
785                                               0 < Size, Size =< ?EXPAND_MAX_SIZE_SEGMENT ->
786    case <<Int:Size>> of
787	<<Int:Size>> -> true;
788	_ -> false
789    end;
790integer_fits_and_is_expandable(_Int, _Size) ->
791    false.
792
793utf8_fits(Utf8) ->
794    try
795	Bin = <<Utf8/utf8>>,
796	Bits = bit_size(Bin),
797	<<Int:Bits>> = Bin,
798	{Int, Bits}
799    catch
800	_:_ -> error
801    end.
802
803%% pattern_list([Cexpr], Sub, State) -> {[Kexpr],Sub,State}.
804
805pattern_list(Ces, Sub, St) ->
806    pattern_list(Ces, Sub, Sub, St).
807
808pattern_list(Ces, Isub, Osub, St) ->
809    foldr(fun (Ce, {Kes,Osub0,St0}) ->
810		  {Ke,Osub1,St1} = pattern(Ce, Isub, Osub0, St0),
811		  {[Ke|Kes],Osub1,St1}
812	  end, {[],Osub,St}, Ces).
813
814%% new_sub() -> Subs.
815%% set_vsub(Name, Sub, Subs) -> Subs.
816%% subst_vsub(Name, Sub, Subs) -> Subs.
817%% get_vsub(Name, Subs) -> SubName.
818%%  Add/get substitute Sub for Name to VarSub.
819%%
820%%  We're using a many-to-one bimap so we can rename all references to a
821%%  variable without having to scan through all of them, which can cause
822%%  compile times to explode (see record_SUITE:slow_compilation/1).
823
824new_sub() -> {#{}, #{}}.
825
826get_vsub(Key, Subs) ->
827    bimap_get(Key, Subs, Key).
828
829get_fsub(Name, Arity, Subs) ->
830    bimap_get({Name, Arity}, Subs, Name).
831
832set_vsub(Same, Same, Subs) ->
833    Subs;
834set_vsub(Key, Val, Subs) ->
835    bimap_set(Key, Val, Subs).
836
837set_fsub(Name, Arity, Val, Subs) ->
838    set_vsub({Name, Arity}, Val, Subs).
839
840subst_vsub(Key, Val, Subs) ->
841    bimap_rename(Key, Val, Subs).
842
843bimap_get(Key, {Map, _InvMap}, Default) ->
844    case Map of
845        #{ Key := Val } -> Val;
846        _ -> Default
847    end.
848
849%% Maps Key to Val without touching existing references to Key.
850bimap_set(Key, Val, {Map0, InvMap0}) ->
851    InvMap = bm_update_inv_lookup(Key, Val, Map0, InvMap0),
852    Map = Map0#{ Key => Val },
853    {Map, InvMap}.
854
855bm_update_inv_lookup(Key, Val, Map, InvMap0) ->
856    InvMap = bm_cleanup_inv_lookup(Key, Map, InvMap0),
857    case InvMap of
858        #{ Val := Keys } ->
859            %% Other keys map to the same value, add ours to the set.
860            InvMap#{ Val := ordsets:add_element(Key, Keys) };
861        #{} ->
862            InvMap#{ Val => [Key] }
863    end.
864
865bm_cleanup_inv_lookup(Key, Map, InvMap) when is_map_key(Key, Map) ->
866    #{ Key := Old } = Map,
867    case InvMap of
868        #{ Old := [Key] } ->
869            maps:remove(Old, InvMap);
870        #{ Old := [_|_]=Keys } ->
871            InvMap#{ Old := ordsets:del_element(Key, Keys) }
872    end;
873bm_cleanup_inv_lookup(_Key, _Map, InvMap) ->
874    InvMap.
875
876%% Maps Key to Val, and replaces all existing references to Key with Val.
877bimap_rename(Key, Val, {Map0, InvMap0}) when is_map_key(Key, InvMap0) ->
878    Keys = map_get(Key, InvMap0),
879
880    Map1 = Map0#{ Key => Val },
881    Map = bimap_update_lookup(Keys, Val, Map1),
882
883    InvMap1 = maps:remove(Key, InvMap0),
884    InvMap = InvMap1#{ Val => ordsets:add_element(Key, Keys) },
885
886    {Map, InvMap};
887bimap_rename(Key, Val, Subs) ->
888    bimap_set(Key, Val, Subs).
889
890bimap_update_lookup([Key | Keys], Val, Map) ->
891    bimap_update_lookup(Keys, Val, Map#{ Key := Val });
892bimap_update_lookup([], _Val, Map) ->
893    Map.
894
895new_fun_name(St) ->
896    new_fun_name("anonymous", St).
897
898%% new_fun_name(Type, State) -> {FunName,State}.
899
900new_fun_name(Type, #kern{func={F,Arity},fcount=C}=St) ->
901    Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(Arity) ++
902	"-" ++ Type ++ "-" ++ integer_to_list(C) ++ "-",
903    {list_to_atom(Name),St#kern{fcount=C+1}}.
904
905%% new_var_name(State) -> {VarName,State}.
906
907new_var_name(#kern{vcount=C}=St) ->
908    {C,St#kern{vcount=C+1}}.
909
910%% new_var(State) -> {#k_var{},State}.
911
912new_var(St0) ->
913    {New,St1} = new_var_name(St0),
914    {#k_var{name=New},St1}.
915
916%% new_vars(Count, State) -> {[#k_var{}],State}.
917%%  Make Count new variables.
918
919new_vars(N, St) -> new_vars(N, St, []).
920
921new_vars(N, St0, Vs) when N > 0 ->
922    {V,St1} = new_var(St0),
923    new_vars(N-1, St1, [V|Vs]);
924new_vars(0, St, Vs) -> {Vs,St}.
925
926make_vars(Vs) -> [ #k_var{name=V} || V <- Vs ].
927
928%% is_remote_bif(Mod, Name, Arity) -> true | false.
929%%  Test if function is really a BIF.
930
931is_remote_bif(erlang, get, [_]) -> true;
932is_remote_bif(erlang, is_record, [_,Tag,Sz]) ->
933    case {Tag,Sz} of
934	{#c_literal{val=Atom},#c_literal{val=Int}}
935          when is_atom(Atom), is_integer(Int) ->
936	    %% Tag and size are literals. This is a guard BIF.
937            true;
938        {_,_} ->
939            false
940    end;
941is_remote_bif(erlang, N, As) ->
942    Arity = length(As),
943    case erl_internal:guard_bif(N, Arity) of
944	true -> true;
945	false ->
946	    try erl_internal:op_type(N, Arity) of
947		arith -> true;
948		bool -> true;
949		comp -> true;
950		list -> false;
951		send -> false
952	    catch
953		_:_ -> false		% not an op
954	    end
955    end;
956is_remote_bif(_, _, _) -> false.
957
958%% bif_vals(Name, Arity) -> integer().
959%% bif_vals(Mod, Name, Arity) -> integer().
960%%  Determine how many return values a BIF has.  Provision for BIFs to
961%%  return multiple values.  Only used in bodies where a BIF may be
962%%  called for effect only.
963
964bif_vals(recv_peek_message, 0) -> 2;
965bif_vals(_, _) -> 1.
966
967bif_vals(_, _, _) -> 1.
968
969%% foldr2(Fun, Acc, List1, List2) -> Acc.
970%%  Fold over two lists.
971
972foldr2(Fun, Acc0, [E1|L1], [E2|L2]) ->
973    Acc1 = Fun(E1, E2, Acc0),
974    foldr2(Fun, Acc1, L1, L2);
975foldr2(_, Acc, [], []) -> Acc.
976
977%% This code implements the algorithm for an optimizing compiler for
978%% pattern matching given "The Implementation of Functional
979%% Programming Languages" by Simon Peyton Jones. The code is much
980%% longer as the meaning of constructors is different from the book.
981%%
982%% In Erlang many constructors can have different values, e.g. 'atom'
983%% or 'integer', whereas in the original algorithm thse would be
984%% different constructors. Our view makes it easier in later passes to
985%% handle indexing over each type.
986%%
987%% Patterns are complicated by having alias variables.  The form of a
988%% pattern is Pat | {alias,Pat,[AliasVar]}.  This is hidden by access
989%% functions to pattern arguments but the code must be aware of it.
990%%
991%% The compilation proceeds in two steps:
992%%
993%% 1. The patterns in the clauses to converted to lists of kernel
994%% patterns.  The Core clause is now hybrid, this is easier to work
995%% with.  Remove clauses with trivially false guards, this simplifies
996%% later passes.  Add locally defined vars and variable subs to each
997%% clause for later use.
998%%
999%% 2. The pattern matching is optimised.  Variable substitutions are
1000%% added to the VarSub structure and new variables are made visible.
1001%% The guard and body are then converted to Kernel form.
1002
1003%% kmatch([Var], [Clause], Sub, State) -> {Kexpr,State}.
1004
1005kmatch(Us, Ccs, Sub, St0) ->
1006    {Cs,St1} = match_pre(Ccs, Sub, St0),	%Convert clauses
1007    Def = fail,
1008    match(Us, Cs, Def, St1).		%Do the match.
1009
1010%% match_pre([Cclause], Sub, State) -> {[Clause],State}.
1011%%  Must be careful not to generate new substitutions here now!
1012%%  Remove clauses with trivially false guards which will never
1013%%  succeed.
1014
1015match_pre(Cs, Sub0, St) ->
1016    foldr(fun (#c_clause{anno=A,pats=Ps,guard=G,body=B}, {Cs0,St0}) ->
1017		  {Kps,Osub1,St1} = pattern_list(Ps, Sub0, St0),
1018		  {[#iclause{anno=A,isub=Sub0,osub=Osub1,
1019			     pats=Kps,guard=G,body=B}|
1020		    Cs0],St1}
1021	  end, {[],St}, Cs).
1022
1023%% match([Var], [Clause], Default, State) -> {MatchExpr,State}.
1024
1025match([_U|_Us] = L, Cs, Def, St0) ->
1026    %%ok = io:format("match ~p~n", [Cs]),
1027    Pcss = partition(Cs),
1028    foldr(fun (Pcs, {D,St}) -> match_varcon(L, Pcs, D, St) end,
1029	  {Def,St0}, Pcss);
1030match([], Cs, Def, St) ->
1031    match_guard(Cs, Def, St).
1032
1033%% match_guard([Clause], Default, State) -> {IfExpr,State}.
1034%%  Build a guard to handle guards. A guard *ALWAYS* fails if no
1035%%  clause matches, there will be a surrounding 'alt' to catch the
1036%%  failure.  Drop redundant cases, i.e. those after a true guard.
1037
1038match_guard(Cs0, Def0, St0) ->
1039    {Cs1,Def1,St1} = match_guard_1(Cs0, Def0, St0),
1040    {build_alt(build_guard(Cs1), Def1),St1}.
1041
1042match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) ->
1043    case is_true_guard(G) of
1044	true ->
1045	    %% The true clause body becomes the default.
1046	    {Kb,Pb,St1} = body(B, Osub, St0),
1047	    St2 = maybe_add_warning(Cs0, A, St1),
1048	    St = maybe_add_warning(Def0, A, St2),
1049	    {[],pre_seq(Pb, Kb),St};
1050	false ->
1051	    {Kg,St1} = guard(G, Osub, St0),
1052	    {Kb,Pb,St2} = body(B, Osub, St1),
1053	    {Cs1,Def1,St3} = match_guard_1(Cs0, Def0, St2),
1054	    {[#k_guard_clause{guard=Kg,body=pre_seq(Pb, Kb)}|Cs1],
1055	     Def1,St3}
1056    end;
1057match_guard_1([], Def, St) -> {[],Def,St}.
1058
1059maybe_add_warning([C|_], MatchAnno, St) ->
1060    maybe_add_warning(C, MatchAnno, St);
1061maybe_add_warning([], _MatchAnno, St) -> St;
1062maybe_add_warning(fail, _MatchAnno, St) -> St;
1063maybe_add_warning(Ke, MatchAnno, St) ->
1064    case is_compiler_generated(Ke) of
1065	true ->
1066	    St;
1067	false ->
1068	    Anno = get_kanno(Ke),
1069	    Line = get_location(Anno),
1070	    MatchLine = get_line(MatchAnno),
1071	    Warn = case MatchLine of
1072		       none -> {nomatch,shadow};
1073		       _ -> {nomatch,{shadow,MatchLine}}
1074		   end,
1075	    add_warning(Line, Warn, Anno, St)
1076    end.
1077
1078get_location([Line|_]) when is_integer(Line) ->
1079    Line;
1080get_location([{Line, Column} | _T]) when is_integer(Line), is_integer(Column) ->
1081    {Line,Column};
1082get_location([_|T]) ->
1083    get_location(T);
1084get_location([]) ->
1085    none.
1086
1087get_line([Line|_]) when is_integer(Line) -> Line;
1088get_line([{Line, _Column} | _T]) when is_integer(Line) -> Line;
1089get_line([_|T]) -> get_line(T);
1090get_line([]) -> none.
1091
1092get_file([{file,File}|_]) -> File;
1093get_file([_|T]) -> get_file(T);
1094get_file([]) -> "no_file". % should not happen
1095
1096%% is_true_guard(Guard) -> boolean().
1097%%  Test if a guard is trivially true.
1098
1099is_true_guard(#c_literal{val=true}) -> true;
1100is_true_guard(_) -> false.
1101
1102%% partition([Clause]) -> [[Clause]].
1103%%  Partition a list of clauses into groups which either contain
1104%%  clauses with a variable first argument, or with a "constructor".
1105
1106partition([C1|Cs]) ->
1107    V1 = is_var_clause(C1),
1108    {More,Rest} = splitwith(fun (C) -> is_var_clause(C) =:= V1 end, Cs),
1109    [[C1|More]|partition(Rest)];
1110partition([]) -> [].
1111
1112%% match_varcon([Var], [Clause], Def, [Var], Sub, State) ->
1113%%        {MatchExpr,State}.
1114
1115match_varcon(Us, [C|_]=Cs, Def, St) ->
1116    case is_var_clause(C) of
1117	true -> match_var(Us, Cs, Def, St);
1118	false -> match_con(Us, Cs, Def, St)
1119    end.
1120
1121%% match_var([Var], [Clause], Def, State) -> {MatchExpr,State}.
1122%%  Build a call to "select" from a list of clauses all containing a
1123%%  variable as the first argument.  We must rename the variable in
1124%%  each clause to be the match variable as these clause will share
1125%%  this variable and may have different names for it.  Rename aliases
1126%%  as well.
1127
1128match_var([U|Us], Cs0, Def, St) ->
1129    Cs1 = map(fun (#iclause{isub=Isub0,osub=Osub0,pats=[Arg|As]}=C) ->
1130		      Vs = [arg_arg(Arg)|arg_alias(Arg)],
1131 		      Osub1 = foldl(fun (#k_var{name=V}, Acc) ->
1132 					   subst_vsub(V, U#k_var.name, Acc)
1133 				   end, Osub0, Vs),
1134 		      Isub1 = foldl(fun (#k_var{name=V}, Acc) ->
1135					    subst_vsub(V, U#k_var.name, Acc)
1136				    end, Isub0, Vs),
1137		      C#iclause{isub=Isub1,osub=Osub1,pats=As}
1138	      end, Cs0),
1139    match(Us, Cs1, Def, St).
1140
1141%% match_con(Variables, [Clause], Default, State) -> {SelectExpr,State}.
1142%%  Build call to "select" from a list of clauses all containing a
1143%%  constructor/constant as first argument.  Group the constructors
1144%%  according to type, the order is really irrelevant but tries to be
1145%%  smart.
1146match_con([U|_Us] = L, Cs, Def, St0) ->
1147    %% Extract clauses for different constructors (types).
1148    %%ok = io:format("match_con ~p~n", [Cs]),
1149    Ttcs0 = select_types(Cs, [], [], [], [], [], [], [], [], []),
1150    Ttcs1 = [{T, Types} || {T, [_ | _] = Types} <- Ttcs0],
1151    Ttcs = opt_single_valued(Ttcs1),
1152    %%ok = io:format("ttcs = ~p~n", [Ttcs]),
1153    {Scs,St1} =
1154	mapfoldl(fun ({T,Tcs}, St) ->
1155			 {[S|_]=Sc,S1} = match_value(L, T, Tcs, fail, St),
1156			 %%ok = io:format("match_con type2 ~p~n", [T]),
1157			 Anno = get_kanno(S),
1158			 {#k_type_clause{anno=Anno,type=T,values=Sc},S1} end,
1159		 St0, Ttcs),
1160    {build_alt_1st_no_fail(build_select(U, Scs), Def),St1}.
1161
1162select_types([NoExpC | Cs], Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil) ->
1163    C = expand_pat_lit_clause(NoExpC),
1164    case clause_con(C) of
1165	k_binary ->
1166	    select_types(Cs, [C |Bin], BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil);
1167	k_bin_seg ->
1168	    select_types(Cs, Bin, [C | BinCon], Cons, Tuple, Map, Atom, Float, Int, Nil);
1169	k_bin_end ->
1170	    select_types(Cs, Bin, [C | BinCon], Cons, Tuple, Map, Atom, Float, Int, Nil);
1171	k_cons ->
1172	    select_types(Cs, Bin, BinCon, [C | Cons], Tuple, Map, Atom, Float, Int, Nil);
1173	k_tuple ->
1174	    select_types(Cs, Bin, BinCon, Cons, [C | Tuple], Map, Atom, Float, Int, Nil);
1175	k_map ->
1176	    select_types(Cs, Bin, BinCon, Cons, Tuple, [C | Map], Atom, Float, Int, Nil);
1177	k_atom ->
1178	    select_types(Cs, Bin, BinCon, Cons, Tuple, Map, [C | Atom], Float, Int, Nil);
1179	k_float ->
1180	    select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, [C | Float], Int, Nil);
1181	k_int ->
1182	    select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, Float, [C | Int], Nil);
1183	k_nil ->
1184	    select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, [C | Nil])
1185    end;
1186select_types([], Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil) ->
1187    [{k_binary, reverse(Bin)}] ++ handle_bin_con(reverse(BinCon)) ++
1188	[
1189	    {k_cons, reverse(Cons)},
1190	    {k_tuple, reverse(Tuple)},
1191	    {k_map, reverse(Map)},
1192	    {k_atom, reverse(Atom)},
1193	    {k_float, reverse(Float)},
1194	    {k_int, reverse(Int)},
1195	    {k_nil, reverse(Nil)}
1196	].
1197
1198expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C) ->
1199    P = expand_pat_lit(Val, A),
1200    C#iclause{pats=[Alias#ialias{pat=P}|Ps]};
1201expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C) ->
1202    P = expand_pat_lit(Val, A),
1203    C#iclause{pats=[P|Ps]};
1204expand_pat_lit_clause(C) -> C.
1205
1206expand_pat_lit([H|T], A) ->
1207    #k_cons{anno=A,hd=#k_literal{anno=A,val=H},tl=#k_literal{anno=A,val=T}};
1208expand_pat_lit(Tuple, A) when is_tuple(Tuple) ->
1209    #k_tuple{anno=A,es=[#k_literal{anno=A,val=E} || E <- tuple_to_list(Tuple)]};
1210expand_pat_lit(Lit, A) ->
1211    #k_literal{anno=A,val=Lit}.
1212
1213%% opt_singled_valued([{Type,Clauses}]) -> [{Type,Clauses}].
1214%%  If a type only has one clause and if the pattern is a complex
1215%%  literal, the matching can be done more efficiently by directly
1216%%  comparing with the literal (that is especially true for binaries).
1217%%
1218%%  It is important not to do this transformation for atomic literals
1219%%  (such as `[]`), since that would cause the test for an emtpy list
1220%%  to be executed before the test for a nonempty list.
1221
1222opt_single_valued(Ttcs) ->
1223    opt_single_valued(Ttcs, [], []).
1224
1225opt_single_valued([{_,[#iclause{pats=[#k_literal{}|_]}]}=Ttc|Ttcs], TtcAcc, LitAcc) ->
1226    %% This is an atomic literal.
1227    opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc);
1228opt_single_valued([{_,[#iclause{pats=[P0|Ps]}=Tc]}=Ttc|Ttcs], TtcAcc, LitAcc) ->
1229    try combine_lit_pat(P0) of
1230        P ->
1231            LitTtc = Tc#iclause{pats=[P|Ps]},
1232            opt_single_valued(Ttcs, TtcAcc, [LitTtc|LitAcc])
1233    catch
1234        not_possible ->
1235            opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc)
1236    end;
1237opt_single_valued([Ttc|Ttcs], TtcAcc, LitAcc) ->
1238    opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc);
1239opt_single_valued([], TtcAcc, []) ->
1240    reverse(TtcAcc);
1241opt_single_valued([], TtcAcc, LitAcc) ->
1242    Literals = {k_literal,reverse(LitAcc)},
1243    %% Test the literals as early as possible.
1244    case reverse(TtcAcc) of
1245        [{k_binary,_}=Bin|Ttcs] ->
1246            %% The delayed creation of sub binaries requires
1247            %% bs_start_match2 to be the first instruction in the
1248            %% function.
1249            [Bin,Literals|Ttcs];
1250        Ttcs ->
1251            [Literals|Ttcs]
1252    end.
1253
1254combine_lit_pat(#ialias{pat=Pat0}=Alias) ->
1255    Pat = combine_lit_pat(Pat0),
1256    Alias#ialias{pat=Pat};
1257combine_lit_pat(#k_literal{}) ->
1258    %% This is an atomic literal. Rewriting would be a pessimization,
1259    %% especially for `[]`.
1260    throw(not_possible);
1261combine_lit_pat(Pat) ->
1262    do_combine_lit_pat(Pat).
1263
1264do_combine_lit_pat(#k_binary{anno=A,segs=Segs}) ->
1265    Bin = combine_bin_segs(Segs),
1266    #k_literal{anno=A,val=Bin};
1267do_combine_lit_pat(#k_cons{anno=A,hd=Hd0,tl=Tl0}) ->
1268    #k_literal{val=Hd} = do_combine_lit_pat(Hd0),
1269    #k_literal{val=Tl} = do_combine_lit_pat(Tl0),
1270    #k_literal{anno=A,val=[Hd|Tl]};
1271do_combine_lit_pat(#k_literal{}=Lit) ->
1272    Lit;
1273do_combine_lit_pat(#k_tuple{anno=A,es=Es0}) ->
1274    Es = [begin
1275              #k_literal{val=Lit} = do_combine_lit_pat(El),
1276              Lit
1277          end || El <- Es0],
1278    #k_literal{anno=A,val=list_to_tuple(Es)};
1279do_combine_lit_pat(_) ->
1280    throw(not_possible).
1281
1282combine_bin_segs(#k_bin_seg{size=#k_literal{val=8},unit=1,type=integer,
1283                            flags=[unsigned,big],seg=#k_literal{val=Int},next=Next})
1284	when is_integer(Int), 0 =< Int, Int =< 255 ->
1285    <<Int,(combine_bin_segs(Next))/bits>>;
1286combine_bin_segs(#k_bin_end{}) ->
1287    <<>>;
1288combine_bin_segs(_) ->
1289    throw(not_possible).
1290
1291%% handle_bin_con([Clause]) -> [{Type,[Clause]}].
1292%%  Handle clauses for the k_bin_seg constructor.  As k_bin_seg
1293%%  matching can overlap, the k_bin_seg constructors cannot be
1294%%  reordered, only grouped.
1295
1296handle_bin_con(Cs) ->
1297    try
1298	%% The usual way to match literals is to first extract the
1299	%% value to a register, and then compare the register to the
1300	%% literal value. Extracting the value is good if we need
1301	%% compare it more than once.
1302	%%
1303	%% But we would like to combine the extracting and the
1304	%% comparing into a single instruction if we know that
1305	%% a binary segment must contain specific integer value
1306	%% or the matching will fail, like in this example:
1307	%%
1308	%% <<42:8,...>> ->
1309	%% <<42:8,...>> ->
1310	%% .
1311	%% .
1312	%% .
1313	%% <<42:8,...>> ->
1314	%% <<>> ->
1315	%%
1316	%% The first segment must either contain the integer 42
1317	%% or the binary must end for the match to succeed.
1318	%%
1319	%% The way we do is to replace the generic #k_bin_seg{}
1320	%% record with a #k_bin_int{} record if all clauses will
1321	%% select the same literal integer (except for one or more
1322	%% clauses that will end the binary).
1323
1324	{BinSegs0,BinEnd} =
1325	    partition(fun (C) ->
1326			      clause_con(C) =:= k_bin_seg
1327		      end, Cs),
1328	BinSegs = select_bin_int(BinSegs0),
1329	case BinEnd of
1330	    [] -> BinSegs;
1331	    [_|_] -> BinSegs ++ [{k_bin_end,BinEnd}]
1332	end
1333    catch
1334	throw:not_possible ->
1335	    handle_bin_con_not_possible(Cs)
1336    end.
1337
1338handle_bin_con_not_possible([C1|Cs]) ->
1339    Con = clause_con(C1),
1340    {More,Rest} = splitwith(fun (C) -> clause_con(C) =:= Con end, Cs),
1341    [{Con,[C1|More]}|handle_bin_con_not_possible(Rest)];
1342handle_bin_con_not_possible([]) -> [].
1343
1344%% select_bin_int([Clause]) -> {k_bin_int,[Clause]}
1345%%  If the first pattern in each clause selects the same integer,
1346%%  rewrite all clauses to use #k_bin_int{} (which will later be
1347%%  translated to a bs_match_string/4 instruction).
1348%%
1349%%  If it is not possible to do this rewrite, a 'not_possible'
1350%%  exception is thrown.
1351
1352select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
1353                                          size=#k_literal{val=Bits0}=Sz,unit=U,
1354                                          flags=Fl,seg=#k_literal{val=Val},
1355                                          next=N}|Ps]}=C|Cs0]) when is_integer(Bits0) ->
1356    Bits = U * Bits0,
1357    if
1358	Bits > ?EXPAND_MAX_SIZE_SEGMENT -> throw(not_possible); %Expands the code too much.
1359	true -> ok
1360    end,
1361    select_assert_match_possible(Bits, Val, Fl),
1362    P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N},
1363    case member(native, Fl) of
1364	true -> throw(not_possible);
1365	false -> ok
1366    end,
1367    Cs = select_bin_int_1(Cs0, Bits, Fl, Val),
1368    [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}];
1369select_bin_int(_) -> throw(not_possible).
1370
1371select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
1372					    size=#k_literal{val=Bits0}=Sz,
1373					    unit=U,
1374					    flags=Fl,seg=#k_literal{val=Val},
1375					    next=N}|Ps]}=C|Cs],
1376		 Bits, Fl, Val) when is_integer(Val) ->
1377    if
1378	Bits0*U =:= Bits -> ok;
1379	true -> throw(not_possible)
1380    end,
1381    P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N},
1382    [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)];
1383select_bin_int_1([], _, _, _) -> [];
1384select_bin_int_1(_, _, _, _) -> throw(not_possible).
1385
1386select_assert_match_possible(Sz, Val, Fs)
1387  when is_integer(Sz), Sz >= 0, is_integer(Val) ->
1388    EmptyBindings = erl_eval:new_bindings(),
1389    MatchFun = match_fun(Val),
1390    EvalFun = fun({integer,_,S}, B) -> {value,S,B} end,
1391    Expr = [{bin_element,0,{integer,0,Val},{integer,0,Sz},[{unit,1}|Fs]}],
1392    {value,Bin,EmptyBindings} = eval_bits:expr_grp(Expr, EmptyBindings, EvalFun),
1393    try
1394	{match,_} = eval_bits:match_bits(Expr, Bin,
1395					 EmptyBindings,
1396					 EmptyBindings,
1397					 MatchFun, EvalFun),
1398	ok  % this is just an assertion (i.e., no return value)
1399    catch
1400	throw:nomatch ->
1401	    throw(not_possible)
1402    end;
1403select_assert_match_possible(_, _, _) ->
1404    throw(not_possible).
1405
1406match_fun(Val) ->
1407    fun(match, {{integer,_,_},NewV,Bs}) when NewV =:= Val ->
1408	    {match,Bs}
1409    end.
1410
1411%% match_value([Var], Con, [Clause], Default, State) -> {SelectExpr,State}.
1412%%  At this point all the clauses have the same constructor, we must
1413%%  now separate them according to value.
1414
1415match_value(Us0, T, Cs0, Def, St0) ->
1416    {Us1,Cs1,St1} = partition_intersection(T, Us0, Cs0, St0),
1417    UCss = group_value(T, Us1, Cs1),
1418    %%ok = io:format("match_value ~p ~p~n", [T, Css]),
1419    mapfoldl(fun ({Us,Cs}, St) -> match_clause(Us, Cs, Def, St) end, St1, UCss).
1420
1421%% partition_intersection(Type, Us, [Clause], State) -> {Us,Cs,State}.
1422%%  Partitions a map into two maps with the most common keys to the
1423%%  first map.
1424%%
1425%%      case <M> of
1426%%          <#{a,b}>
1427%%          <#{a,c}>
1428%%          <#{a}>
1429%%      end
1430%%
1431%%  becomes
1432%%
1433%%      case <M,M> of
1434%%          <#{a}, #{b}>
1435%%          <#{a}, #{c}>
1436%%          <#{a}, #{ }>
1437%%      end
1438%%
1439%%  The intention is to group as many keys together as possible and
1440%%  thus reduce the number of lookups to that key.
1441
1442partition_intersection(k_map, [U|_]=Us, [_,_|_]=Cs0, St0) ->
1443    Ps = [clause_val(C) || C <- Cs0],
1444    case find_key_intersection(Ps) of
1445        none ->
1446            {Us,Cs0,St0};
1447        Ks ->
1448            Cs1 = map(fun(#iclause{pats=[Arg|Args]}=C) ->
1449                              {Arg1,Arg2} = partition_keys(Arg, Ks),
1450                              C#iclause{pats=[Arg1,Arg2|Args]}
1451                      end, Cs0),
1452            {[U|Us],Cs1,St0}
1453    end;
1454partition_intersection(_, Us, Cs, St) ->
1455    {Us,Cs,St}.
1456
1457partition_keys(#k_map{es=Pairs}=Map, Ks) ->
1458    F = fun(#k_map_pair{key=Key}) ->
1459                sets:is_element(map_key_clean(Key), Ks)
1460        end,
1461    {Ps1,Ps2} = partition(F, Pairs),
1462    {Map#k_map{es=Ps1},Map#k_map{es=Ps2}};
1463partition_keys(#ialias{pat=Map}=Alias, Ks) ->
1464    %% Only alias one of them.
1465    {Map1,Map2} = partition_keys(Map, Ks),
1466    {Map1,Alias#ialias{pat=Map2}}.
1467
1468find_key_intersection(Ps) ->
1469    Sets = [sets:from_list(Ks, [{version, 2}]) || Ks <- Ps],
1470    Intersection = sets:intersection(Sets),
1471    case sets:is_empty(Intersection) of
1472        true ->
1473            none;
1474        false ->
1475            All = all(fun (Kset) -> Kset =:= Intersection end, Sets),
1476            case All of
1477                true ->
1478                    %% All clauses test the same keys. Partitioning
1479                    %% the keys could only make the code worse.
1480                    none;
1481                false ->
1482                    Intersection
1483            end
1484    end.
1485
1486%% group_value([Clause]) -> [[Clause]].
1487%%  Group clauses according to value.  Here we know that
1488%%  1. Some types are singled valued
1489%%  2. The clauses in maps and bin_segs cannot be reordered,
1490%%     only grouped
1491%%  3. Other types are disjoint and can be reordered
1492
1493group_value(k_cons, Us, Cs)    -> [{Us,Cs}];  %These are single valued
1494group_value(k_nil, Us, Cs)     -> [{Us,Cs}];
1495group_value(k_binary, Us, Cs)  -> [{Us,Cs}];
1496group_value(k_bin_end, Us, Cs) -> [{Us,Cs}];
1497group_value(k_bin_seg, Us, Cs) -> group_keeping_order(Us, Cs);
1498group_value(k_bin_int, Us, Cs) -> [{Us,Cs}];
1499group_value(k_map, Us, Cs)     -> group_keeping_order(Us, Cs);
1500group_value(_, Us, Cs) ->
1501    Map = group_values(Cs, #{}),
1502    %% We must sort the grouped values to ensure consistent
1503    %% order from compilation to compilation.
1504    sort(maps:fold(fun (_, Vcs, Css) ->
1505                           [{Us,reverse(Vcs)}|Css]
1506                   end, [], Map)).
1507
1508group_values([C|Cs], Acc) ->
1509    Val = clause_val(C),
1510    case Acc of
1511        #{Val:=Gcs} ->
1512            group_values(Cs, Acc#{Val:=[C|Gcs]});
1513        #{} ->
1514            group_values(Cs, Acc#{Val=>[C]})
1515    end;
1516group_values([], Acc) -> Acc.
1517
1518group_keeping_order(Us, [C1|Cs]) ->
1519    V1 = clause_val(C1),
1520    {More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs),
1521    [{Us,[C1|More]}|group_keeping_order(Us, Rest)];
1522group_keeping_order(_, []) -> [].
1523
1524%% match_clause([Var], [Clause], Default, State) -> {Clause,State}.
1525%%  At this point all the clauses have the same "value".  Build one
1526%%  select clause for this value and continue matching.  Rename
1527%%  aliases as well.
1528
1529match_clause([U|Us], [C|_]=Cs0, Def, St0) ->
1530    Anno = get_kanno(C),
1531    {Match0,Vs,St1} = get_match(get_con(Cs0), St0),
1532    Match = sub_size_var(Match0, Cs0),
1533    {Cs1,St2} = new_clauses(Cs0, U, St1),
1534    Cs2 = squeeze_clauses_by_bin_integer_count(Cs1, []),
1535    {B,St3} = match(Vs ++ Us, Cs2, Def, St2),
1536    {#k_val_clause{anno=Anno,val=Match,body=B},St3}.
1537
1538sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) ->
1539    BinSeg#k_bin_seg{size=Kvar#k_var{name=get_vsub(Name, Sub)}};
1540sub_size_var(K, _) -> K.
1541
1542get_con([C|_]) -> arg_arg(clause_arg(C)).	%Get the constructor
1543
1544get_match(#k_cons{}, St0) ->
1545    {[H,T]=L,St1} = new_vars(2, St0),
1546    {#k_cons{hd=H,tl=T},L,St1};
1547get_match(#k_binary{}, St0) ->
1548    {[V]=Mes,St1} = new_vars(1, St0),
1549    {#k_binary{segs=V},Mes,St1};
1550get_match(#k_bin_seg{size=#k_literal{val=all},next={k_bin_end,[]}}=Seg, St0) ->
1551    {[S,N],St1} = new_vars(2, St0),
1552    {Seg#k_bin_seg{seg=S,next=N},[S],St1};
1553get_match(#k_bin_seg{}=Seg, St0) ->
1554    {[S,N],St1} = new_vars(2, St0),
1555    {Seg#k_bin_seg{seg=S,next=N},[S,N],St1};
1556get_match(#k_bin_int{}=BinInt, St0) ->
1557    {N,St1} = new_var(St0),
1558    {BinInt#k_bin_int{next=N},[N],St1};
1559get_match(#k_tuple{es=Es}, St0) ->
1560    {Mes,St1} = new_vars(length(Es), St0),
1561    {#k_tuple{es=Mes},Mes,St1};
1562get_match(#k_map{op=exact,es=Es0}, St0) ->
1563    {Mes,St1} = new_vars(length(Es0), St0),
1564    {Es,_} = mapfoldl(fun
1565	    (#k_map_pair{}=Pair, [V|Vs]) ->
1566		{Pair#k_map_pair{val=V},Vs}
1567	end, Mes, Es0),
1568    {#k_map{op=exact,es=Es},Mes,St1};
1569get_match(M, St) ->
1570    {M,[],St}.
1571
1572new_clauses(Cs0, U, St) ->
1573    Cs1 = map(fun (#iclause{isub=Isub0,osub=Osub0,pats=[Arg|As]}=C) ->
1574		      Head = case arg_arg(Arg) of
1575				 #k_cons{hd=H,tl=T} -> [H,T|As];
1576				 #k_tuple{es=Es} -> Es ++ As;
1577				 #k_binary{segs=E}  -> [E|As];
1578				 #k_bin_seg{size=#k_literal{val=all},
1579					    seg=S,next={k_bin_end,[]}} ->
1580				     [S|As];
1581				 #k_bin_seg{seg=S,next=N} ->
1582				     [S,N|As];
1583				 #k_bin_int{next=N} ->
1584				     [N|As];
1585				 #k_map{op=exact,es=Es} ->
1586				     Vals = [V || #k_map_pair{val=V} <- Es],
1587				     Vals ++ As;
1588				 _Other ->
1589				     As
1590			     end,
1591		      Vs = arg_alias(Arg),
1592		      Osub1 = foldl(fun (#k_var{name=V}, Acc) ->
1593					    subst_vsub(V, U#k_var.name, Acc)
1594				    end, Osub0, Vs),
1595		      Isub1 = foldl(fun (#k_var{name=V}, Acc) ->
1596					    subst_vsub(V, U#k_var.name, Acc)
1597				    end, Isub0, Vs),
1598		      C#iclause{isub=Isub1,osub=Osub1,pats=Head}
1599	      end, Cs0),
1600    {Cs1,St}.
1601
1602%% group and squeeze
1603%%  The goal of those functions is to group subsequent integer k_bin_seg
1604%%  literals by count so we can leverage bs_get_integer_16 whenever possible.
1605%%
1606%%  The priority is to create large groups. So if we have three clauses matching
1607%%  on 16-bits/16-bits/8-bits, we will first have a single 8-bits match for all
1608%%  three clauses instead of clauses (one with 16 and another with 8). But note
1609%%  the algorithm is recursive, so the remaining 8-bits for the first two clauses
1610%%  will be grouped next.
1611%%
1612%%  We also try to not create too large groups. If we have too many clauses,
1613%%  it is preferrable to match on 8-bits, select a branch, then match on the
1614%%  next 8-bits, rather than match on 16-bits which would force us to have
1615%%  to select to many values at the same time, which would not be efficient.
1616%%
1617%%  Another restriction is that we create groups only if the end of the
1618%%  group is a variadic clause or the end of the binary. That's because
1619%%  if we have 16-bits/16-bits/catch-all, breaking it into a 16-bits lookup
1620%%  will make the catch-all more expensive.
1621%%
1622%%  Clauses are grouped in reverse when squeezing and then flattened and
1623%%  re-reversed at the end.
1624squeeze_clauses_by_bin_integer_count([Clause | Clauses], Acc) ->
1625    case clause_count_bin_integer_segments(Clause) of
1626	{literal, N} -> squeeze_clauses_by_bin_integer_count(Clauses, N, 1, [Clause], Acc);
1627	_ -> squeeze_clauses_by_bin_integer_count(Clauses, [[Clause] | Acc])
1628    end;
1629squeeze_clauses_by_bin_integer_count(_, Acc) ->
1630    flat_reverse(Acc, []).
1631
1632squeeze_clauses_by_bin_integer_count([], N, Count, GroupAcc, Acc) ->
1633    Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count),
1634    flat_reverse([Squeezed | Acc], []);
1635squeeze_clauses_by_bin_integer_count([#iclause{pats=[#k_bin_end{} | _]} = Clause], N, Count, GroupAcc, Acc) ->
1636    Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count),
1637    flat_reverse([[Clause | Squeezed] | Acc], []);
1638squeeze_clauses_by_bin_integer_count([Clause | Clauses], N, Count, GroupAcc, Acc) ->
1639    case clause_count_bin_integer_segments(Clause) of
1640	{literal, NewN} ->
1641	    squeeze_clauses_by_bin_integer_count(Clauses, min(N, NewN), Count + 1, [Clause | GroupAcc], Acc);
1642
1643	{variadic, NewN} when NewN =< N ->
1644	    Squeezed = squeeze_clauses(GroupAcc, NewN, Count),
1645	    squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | Squeezed] | Acc]);
1646
1647	_ ->
1648	    squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | GroupAcc] | Acc])
1649    end.
1650
1651clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | _]}) ->
1652    count_bin_integer_segments(BinSeg, 0);
1653clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{size=#k_literal{val=Size},unit=Unit,
1654                                                            type=integer,flags=[unsigned,big],
1655                                                            seg=#k_var{}} | _]})
1656  when ((Size * Unit) rem 8) =:= 0 ->
1657    {variadic, (Size * Unit) div 8};
1658clause_count_bin_integer_segments(_) ->
1659    error.
1660
1661count_bin_integer_segments(#k_bin_seg{size=#k_literal{val=8},unit=1,type=integer,flags=[unsigned,big],
1662                                      seg=#k_literal{val=Int},next=Next}, Count)
1663  when is_integer(Int), 0 =< Int, Int =< 255 ->
1664    count_bin_integer_segments(Next, Count + 1);
1665count_bin_integer_segments(_, Count) when Count > 0 ->
1666    {literal, Count};
1667count_bin_integer_segments(_, _Count) ->
1668    error.
1669
1670%% Since 4 bytes in on 32-bits systems are bignums, we convert
1671%% anything more than 3 into 2 bytes lookup. The goal is to convert
1672%% any multi-clause segment into 2-byte lookups with a potential
1673%% 3 byte lookup at the end.
1674fix_count_without_variadic_segment(N) when N > 3 -> 2;
1675fix_count_without_variadic_segment(N) -> N.
1676
1677%% If we have more than 16 clauses, then it is better
1678%% to branch multiple times than getting a large integer.
1679%% We also abort if we have nothing to squeeze.
1680squeeze_clauses(Clauses, Size, Count) when Count >= 16; Size =< 1 -> Clauses;
1681squeeze_clauses(Clauses, Size, _Count) ->
1682    squeeze_clauses(Clauses, Size).
1683
1684squeeze_clauses([#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | Pats]} = Clause | Clauses], Size) ->
1685    [Clause#iclause{pats=[squeeze_segments(BinSeg, 0, 0, Size) | Pats]} |
1686     squeeze_clauses(Clauses, Size)];
1687squeeze_clauses([], _Size) ->
1688    [].
1689
1690squeeze_segments(#k_bin_seg{size=Sz, seg=#k_literal{val=Val}=Lit} = BinSeg, Acc, Size, 1) ->
1691    BinSeg#k_bin_seg{size=Sz#k_literal{val=Size + 8}, seg=Lit#k_literal{val=(Acc bsl 8) bor Val}};
1692squeeze_segments(#k_bin_seg{seg=#k_literal{val=Val},next=Next}, Acc, Size, Count) ->
1693    squeeze_segments(Next, (Acc bsl 8) bor Val, Size + 8, Count - 1);
1694squeeze_segments(#k_bin_end{}, Acc, Size, Count) ->
1695    error({Acc,Size,Count}).
1696
1697
1698flat_reverse([Head | Tail], Acc) -> flat_reverse(Tail, flat_reverse_1(Head, Acc));
1699flat_reverse([], Acc) -> Acc.
1700
1701flat_reverse_1([Head | Tail], Acc) -> flat_reverse_1(Tail, [Head | Acc]);
1702flat_reverse_1([], Acc) -> Acc.
1703
1704%% build_guard([GuardClause]) -> GuardExpr.
1705
1706build_guard([]) -> fail;
1707build_guard(Cs) -> #k_guard{clauses=Cs}.
1708
1709%% build_select(Var, [ConClause]) -> SelectExpr.
1710
1711build_select(V, [Tc|_]=Tcs) ->
1712    copy_anno(#k_select{var=V,types=Tcs}, Tc).
1713
1714%% build_alt(First, Then) -> AltExpr.
1715%%  Build an alt, attempt some simple optimisation.
1716
1717build_alt(fail, Then) -> Then;
1718build_alt(First,Then) -> build_alt_1st_no_fail(First, Then).
1719
1720build_alt_1st_no_fail(First, fail) -> First;
1721build_alt_1st_no_fail(First, Then) ->
1722    copy_anno(#k_alt{first=First,then=Then}, First).
1723
1724%% build_match(MatchExpr) -> Kexpr.
1725%%  Build a match expr if there is a match.
1726
1727build_match(#k_alt{}=Km) -> copy_anno(#k_match{body=Km}, Km);
1728build_match(#k_select{}=Km) -> copy_anno(#k_match{body=Km}, Km);
1729build_match(#k_guard{}=Km) -> copy_anno(#k_match{body=Km}, Km);
1730build_match(Km) -> Km.
1731
1732%% clause_arg(Clause) -> FirstArg.
1733%% clause_con(Clause) -> Constructor.
1734%% clause_val(Clause) -> Value.
1735%% is_var_clause(Clause) -> boolean().
1736
1737clause_arg(#iclause{pats=[Arg|_]}) -> Arg.
1738
1739clause_con(C) -> arg_con(clause_arg(C)).
1740
1741clause_val(C) -> arg_val(clause_arg(C), C).
1742
1743is_var_clause(C) -> clause_con(C) =:= k_var.
1744
1745%% arg_arg(Arg) -> Arg.
1746%% arg_alias(Arg) -> Aliases.
1747%% arg_con(Arg) -> Constructor.
1748%% arg_val(Arg) -> Value.
1749%%  These are the basic functions for obtaining fields in an argument.
1750
1751arg_arg(#ialias{pat=Con}) -> Con;
1752arg_arg(Con) -> Con.
1753
1754arg_alias(#ialias{vars=As}) -> As;
1755arg_alias(_Con) -> [].
1756
1757arg_con(Arg) ->
1758    case arg_arg(Arg) of
1759	#k_cons{} -> k_cons;
1760	#k_tuple{} -> k_tuple;
1761	#k_map{} -> k_map;
1762	#k_binary{} -> k_binary;
1763	#k_bin_end{} -> k_bin_end;
1764	#k_bin_seg{} -> k_bin_seg;
1765	#k_var{} -> k_var;
1766	#k_literal{val=[]} -> k_nil;
1767	#k_literal{val=Val} ->
1768            if
1769                is_atom(Val) -> k_atom;
1770                is_integer(Val) -> k_int;
1771                is_float(Val) -> k_float;
1772                true -> k_literal
1773            end
1774    end.
1775
1776arg_val(Arg, C) ->
1777    case arg_arg(Arg) of
1778	#k_literal{val=Lit} -> Lit;
1779	#k_tuple{es=Es} -> length(Es);
1780	#k_bin_seg{size=S,unit=U,type=T,flags=Fs} ->
1781	    case S of
1782		#k_var{name=V} ->
1783		    #iclause{isub=Isub} = C,
1784		    {#k_var{name=get_vsub(V, Isub)},U,T,Fs};
1785		_ ->
1786		    {set_kanno(S, []),U,T,Fs}
1787	    end;
1788	#k_map{op=exact,es=Es} ->
1789            sort(fun(A,B) ->
1790			%% on the form K :: {'lit' | 'var', term()}
1791			%% lit < var as intended
1792			erts_internal:cmp_term(A,B) < 0
1793		end, [map_key_clean(Key) || #k_map_pair{key=Key} <- Es])
1794    end.
1795
1796%% ubody_used_vars(Expr, State) -> [UsedVar]
1797%%  Return all used variables for the body sequence. Much more
1798%%  efficient than using ubody/3 if the body contains nested letrecs.
1799ubody_used_vars(Expr, St) ->
1800    {_,Used,_} = ubody(Expr, return, St#kern{funs=ignore}),
1801    Used.
1802
1803%% ubody(Expr, Break, State) -> {Expr,[UsedVar],State}.
1804%%  Tag the body sequence with its used variables.  These bodies
1805%%  either end with a #k_break{}, or with #k_return{} or an expression
1806%%  which itself can return, #k_enter{}, #k_match{} ... .
1807
1808ubody(#iset{vars=[],arg=#iletrec{}=Let,body=B0}, Br, St0) ->
1809    %% An iletrec{} should never be last.
1810    St = iletrec_funs(Let, St0),
1811    ubody(B0, Br, St);
1812ubody(#iset{vars=[],arg=#k_literal{},body=B0}, Br, St0) ->
1813    ubody(B0, Br, St0);
1814ubody(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Br, St0) ->
1815    {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0),
1816    {B1,Bu,St2} = ubody(B0, Br, St1),
1817    Ns = lit_list_vars(Vs),
1818    Used = union(Eu, subtract(Bu, Ns)),		%Used external vars
1819    {#k_seq{anno=A,arg=E1,body=B1},Used,St2};
1820ubody(#ivalues{anno=A,args=As}, return, St) ->
1821    Au = lit_list_vars(As),
1822    {#k_return{anno=A,args=As},Au,St};
1823ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) ->
1824    Au = lit_list_vars(As),
1825    {#k_break{anno=A,args=As},Au,St};
1826ubody(#k_goto{}=Goto, _Br, St) ->
1827    {Goto,[],St};
1828ubody(E, return, St0) ->
1829    %% Enterable expressions need no trailing return.
1830    case is_enter_expr(E) of
1831	true -> uexpr(E, return, St0);
1832	false ->
1833	    {Ea,Pa,St1} = force_atomic(E, St0),
1834	    ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1)
1835    end;
1836ubody(E, {break,[_]} = Break, St0) ->
1837    {Ea,Pa,St1} = force_atomic(E, St0),
1838    ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1);
1839ubody(E, {break,Rs}=Break, St0) ->
1840    {Vs,St1} = new_vars(length(Rs), St0),
1841    Iset = #iset{vars=Vs,arg=E},
1842    PreSeq = pre_seq([Iset], #ivalues{args=Vs}),
1843    ubody(PreSeq, Break, St1).
1844
1845iletrec_funs(#iletrec{defs=Fs}, St0) ->
1846    %% Use union of all free variables.
1847    %% First just work out free variables for all functions.
1848    Free = foldl(fun ({_,#ifun{vars=Vs,body=Fb0}}, Free0) ->
1849			 Fbu = ubody_used_vars(Fb0, St0),
1850			 Ns = lit_list_vars(Vs),
1851			 Free1 = subtract(Fbu, Ns),
1852			 union(Free1, Free0)
1853		 end, [], Fs),
1854    FreeVs = make_vars(Free),
1855    %% Add this free info to State.
1856    St1 = foldl(fun ({N,#ifun{vars=Vs}}, Lst) ->
1857			store_free(N, length(Vs), FreeVs, Lst)
1858		end, St0, Fs),
1859    iletrec_funs_gen(Fs, FreeVs, St1).
1860
1861%% Now regenerate local functions to use free variable information.
1862iletrec_funs_gen(_, _, #kern{funs=ignore}=St) ->
1863    %% Optimization: The ultimate caller is only interested in the used variables,
1864    %% not the updated state. Makes a difference if there are nested letrecs.
1865    St;
1866iletrec_funs_gen(Fs, FreeVs, St) ->
1867    foldl(fun ({N,#ifun{anno=Fa,vars=Vs,body=Fb0}}, Lst0) ->
1868		  Arity0 = length(Vs),
1869		  {Fb1,_,Lst1} = ubody(Fb0, return, Lst0),
1870		  Arity = Arity0 + length(FreeVs),
1871                  Fun = make_fdef(Fa, N, Arity, Vs++FreeVs, Fb1),
1872		  Lst1#kern{funs=[Fun|Lst1#kern.funs]}
1873	  end, St, Fs).
1874
1875
1876%% is_enter_expr(Kexpr) -> boolean().
1877%%  Test whether Kexpr is "enterable", i.e. can handle return from
1878%%  within itself without extra #k_return{}.
1879
1880is_enter_expr(#k_try{}) -> true;
1881is_enter_expr(#k_call{}) -> true;
1882is_enter_expr(#k_match{}) -> true;
1883is_enter_expr(#k_letrec_goto{}) -> true;
1884is_enter_expr(_) -> false.
1885
1886%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}.
1887%%  Calculate the used variables for an expression.
1888%%  Break = return | {break,[RetVar]}.
1889
1890uexpr(#k_test{anno=A,op=Op,args=As}=Test, {break,Rs}, St) ->
1891    [] = Rs,					%Sanity check
1892    Used = union(op_vars(Op), lit_list_vars(As)),
1893    {Test#k_test{anno=A},Used,St};
1894uexpr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, {break,_}=Br, St0) ->
1895    Ns = lit_list_vars(Vs),
1896    {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0),
1897    {B1,Bu,St2} = uexpr(B0, Br, St1),
1898    Used = union(Eu, subtract(Bu, Ns)),
1899    {#k_seq{anno=A,arg=E1,body=B1},Used,St2};
1900uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) ->
1901    Free = get_free(F, Ar, St),
1902    As1 = As0 ++ Free,				%Add free variables LAST!
1903    Used = lit_list_vars(As1),
1904    {case Br of
1905	 {break,Rs} ->
1906	     Call#k_call{anno=A,
1907			 op=Op#k_local{arity=Ar + length(Free)},
1908			 args=As1,ret=Rs};
1909	 return ->
1910	     #k_enter{anno=A,
1911		      op=Op#k_local{arity=Ar + length(Free)},
1912		      args=As1}
1913     end,Used,St};
1914uexpr(#k_call{anno=A,op=Op,args=As}=Call, {break,Rs}, St) ->
1915    Used = union(op_vars(Op), lit_list_vars(As)),
1916    {Call#k_call{anno=A,ret=Rs},Used,St};
1917uexpr(#k_call{anno=A,op=Op,args=As}, return, St) ->
1918    Used = union(op_vars(Op), lit_list_vars(As)),
1919    {#k_enter{anno=A,op=Op,args=As},Used,St};
1920uexpr(#k_bif{anno=A,op=Op,args=As}=Bif, {break,Rs}, St0) ->
1921    Used = union(op_vars(Op), lit_list_vars(As)),
1922    {Brs,St1} = bif_returns(Op, Rs, St0),
1923    {Bif#k_bif{anno=A,ret=Brs},Used,St1};
1924uexpr(#k_match{anno=A,body=B0}, Br, St0) ->
1925    Rs = break_rets(Br),
1926    {B1,Bu,St1} = umatch(B0, Br, St0),
1927    {#k_match{anno=A,body=B1,ret=Rs},Bu,St1};
1928uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
1929      {break,Rs0}=Br, St0) ->
1930    case {Vs,B0,H0,Rs0} of
1931	{[#k_var{name=X}],#k_var{name=X},#k_literal{},[]} ->
1932            %% This is a simple try/catch whose return value is
1933            %% ignored:
1934            %%
1935            %%   try E of V -> V when _:_:_ -> ignored_literal end, ...
1936            %%
1937            %% This is most probably a try/catch in a guard. To
1938            %% correctly handle the #k_test{} that ends the body of
1939            %% the guard, we MUST pass an empty list of break
1940            %% variables when processing the body.
1941	    {A1,Bu,St} = ubody(A0, {break,[]}, St0),
1942	    {#k_try{anno=A,arg=A1,vars=[],body=#k_break{},
1943                    evars=[],handler=#k_break{},ret=Rs0},
1944	     Bu,St};
1945	{_,_,_,_} ->
1946            %% The general try/catch (in a guard or in body).
1947	    {Avs,St1} = new_vars(length(Vs), St0),
1948	    {A1,Au,St2} = ubody(A0, {break,Avs}, St1),
1949	    {B1,Bu,St3} = ubody(B0, Br, St2),
1950	    {H1,Hu,St4} = ubody(H0, Br, St3),
1951	    Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
1952			  subtract(Hu, lit_list_vars(Evs))]),
1953	    {#k_try{anno=A,arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs0},
1954	     Used,St4}
1955    end;
1956uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
1957      return, St0) ->
1958    {Avs,St1} = new_vars(length(Vs), St0),	%Need dummy names here
1959    {A1,Au,St2} = ubody(A0, {break,Avs}, St1),	%Must break to clean up here!
1960    {B1,Bu,St3} = ubody(B0, return, St2),
1961    {H1,Hu,St4} = ubody(H0, return, St3),
1962    Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
1963		  subtract(Hu, lit_list_vars(Evs))]),
1964    {#k_try_enter{anno=A,arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1},
1965     Used,St4};
1966uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) ->
1967    {Rb,St1} = new_var(St0),
1968    {B1,Bu,St2} = ubody(B0, {break,[Rb]}, St1),
1969    %% Guarantee ONE return variable.
1970    {Ns,St3} = new_vars(1 - length(Rs0), St2),
1971    Rs1 = Rs0 ++ Ns,
1972    {#k_catch{anno=A,body=B1,ret=Rs1},Bu,St3};
1973uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) ->
1974    {B1,Bu,St1} = ubody(B0, return, St0),	%Return out of new function
1975    Ns = lit_list_vars(Vs),
1976    Free = subtract(Bu, Ns),			%Free variables in fun
1977    Fvs = make_vars(Free),
1978    Arity = length(Vs) + length(Free),
1979    {Fname,St} =
1980        case keyfind(id, 1, A) of
1981	    {id,{_,_,Fname0}} ->
1982		{Fname0,St1};
1983	    false ->
1984		%% No id annotation. Must invent a fun name.
1985		new_fun_name(St1)
1986	end,
1987    Fun = make_fdef(A, Fname, Arity, Vs++Fvs, B1),
1988    Local = #k_local{name=Fname,arity=Arity},
1989    {#k_bif{anno=A,
1990	    op=#k_internal{name=make_fun,arity=length(Free)+2},
1991	    args=[Local|Fvs],
1992 	    ret=Rs},
1993     Free,add_local_function(Fun, St)};
1994uexpr(#k_letrec_goto{anno=A,first=F0,then=T0}=MatchAlt, Br, St0) ->
1995    Rs = break_rets(Br),
1996    {F1,Fu,St1} = ubody(F0, Br, St0),
1997    {T1,Tu,St2} = ubody(T0, Br, St1),
1998    Used = union(Fu, Tu),
1999    {MatchAlt#k_letrec_goto{anno=A,first=F1,then=T1,ret=Rs},Used,St2};
2000uexpr(Lit, {break,Rs0}, St0) ->
2001    %% Transform literals to puts here.
2002    %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]),
2003    Used = lit_vars(Lit),
2004    {Rs,St1} = ensure_return_vars(Rs0, St0),
2005    {#k_put{anno=get_kanno(Lit),arg=Lit,ret=Rs},Used,St1}.
2006
2007add_local_function(_, #kern{funs=ignore}=St) ->
2008    St;
2009add_local_function(#k_fdef{func=Name,arity=Arity}=F, #kern{funs=Funs}=St) ->
2010    case is_defined(Name, Arity, Funs) of
2011        false ->
2012            St#kern{funs=[F|Funs]};
2013        true ->
2014            St
2015    end.
2016
2017is_defined(Name, Arity, [#k_fdef{func=Name,arity=Arity}|_]) ->
2018    true;
2019is_defined(Name, Arity, [#k_fdef{}|T]) ->
2020    is_defined(Name, Arity, T);
2021is_defined(_, _, []) -> false.
2022
2023%% Make a #k_fdef{}, making sure that the body is always a #k_match{}.
2024make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) ->
2025    #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Body};
2026make_fdef(Anno, Name, Arity, Vs, Body) ->
2027    Ka = get_kanno(Body),
2028    Match = #k_match{anno=Ka,body=Body,ret=[]},
2029    #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Match}.
2030
2031%% get_free(Name, Arity, State) -> [Free].
2032%% store_free(Name, Arity, [Free], State) -> State.
2033
2034get_free(F, A, #kern{free=FreeMap}) ->
2035    Key = {F,A},
2036    case FreeMap of
2037	#{Key:=Val} -> Val;
2038	_ -> []
2039    end.
2040
2041store_free(F, A, Free, #kern{free=FreeMap0}=St) ->
2042    Key = {F,A},
2043    FreeMap = FreeMap0#{Key=>Free},
2044    St#kern{free=FreeMap}.
2045
2046break_rets({break,Rs}) -> Rs;
2047break_rets(return) -> [].
2048
2049%% bif_returns(Op, [Ret], State) -> {[Ret],State}.
2050
2051bif_returns(#k_remote{mod=M,name=N,arity=Ar}, Rs, St0) ->
2052    %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,{M,N,Ar,Rs}]),
2053    {Ns,St1} = new_vars(bif_vals(M, N, Ar) - length(Rs), St0),
2054    {Rs ++ Ns,St1};
2055bif_returns(#k_internal{name=N,arity=Ar}, Rs, St0) ->
2056    %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,{N,Ar,Rs}]),
2057    {Ns,St1} = new_vars(bif_vals(N, Ar) - length(Rs), St0),
2058    {Rs ++ Ns,St1}.
2059
2060%% ensure_return_vars([Ret], State) -> {[Ret],State}.
2061
2062ensure_return_vars([], St) -> new_vars(1, St);
2063ensure_return_vars([_]=Rs, St) -> {Rs,St}.
2064
2065%% umatch(Match, Break, State) -> {Match,[UsedVar],State}.
2066%%  Calculate the used variables for a match expression.
2067
2068umatch(#k_alt{anno=A,first=F0,then=T0}, Br, St0) ->
2069    {F1,Fu,St1} = umatch(F0, Br, St0),
2070    {T1,Tu,St2} = umatch(T0, Br, St1),
2071    Used = union(Fu, Tu),
2072    {#k_alt{anno=A,first=F1,then=T1},Used,St2};
2073umatch(#k_select{anno=A,var=V,types=Ts0}, Br, St0) ->
2074    {Ts1,Tus,St1} = umatch_list(Ts0, Br, St0),
2075    Used = add_element(V#k_var.name, Tus),
2076    {#k_select{anno=A,var=V,types=Ts1},Used,St1};
2077umatch(#k_type_clause{anno=A,type=T,values=Vs0}, Br, St0) ->
2078    {Vs1,Vus,St1} = umatch_list(Vs0, Br, St0),
2079    {#k_type_clause{anno=A,type=T,values=Vs1},Vus,St1};
2080umatch(#k_val_clause{anno=A,val=P0,body=B0}, Br, St0) ->
2081    {U0,Ps} = pat_vars(P0),
2082    {B1,Bu,St1} = umatch(B0, Br, St0),
2083    P = pat_anno_unused(P0, Bu, Ps),
2084    Used = union(U0, subtract(Bu, Ps)),
2085    {#k_val_clause{anno=A,val=P,body=B1},Used,St1};
2086umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) ->
2087    {Gs1,Gus,St1} = umatch_list(Gs0, Br, St0),
2088    {#k_guard{anno=A,clauses=Gs1},Gus,St1};
2089umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) ->
2090    {G1,Gu,St1} = uexpr(G0, {break,[]}, St0),
2091    {B1,Bu,St2} = umatch(B0, Br, St1),
2092    Used = union(Gu, Bu),
2093    {#k_guard_clause{anno=A,guard=G1,body=B1},Used,St2};
2094umatch(B0, Br, St0) -> ubody(B0, Br, St0).
2095
2096umatch_list(Ms0, Br, St) ->
2097    foldr(fun (M0, {Ms1,Us,Sta}) ->
2098		  {M1,Mu,Stb} = umatch(M0, Br, Sta),
2099		  {[M1|Ms1],union(Mu, Us),Stb}
2100	  end, {[],[],St}, Ms0).
2101
2102pat_anno_unused(#k_tuple{es=Es0}=P, Used0, Ps) ->
2103    %% Not extracting unused tuple elements is an optimization for
2104    %% compile time and memory use during compilation. It is probably
2105    %% worthwhile because it is common to extract only a few elements
2106    %% from a huge record.
2107    Used = intersection(Used0, Ps),
2108    Es = [case member(V, Used) of
2109              true -> Var;
2110              false -> set_kanno(Var, [unused|get_kanno(Var)])
2111          end || #k_var{name=V}=Var <- Es0],
2112    P#k_tuple{es=Es};
2113pat_anno_unused(P, _Used, _Ps) -> P.
2114
2115%% op_vars(Op) -> [VarName].
2116
2117op_vars(#k_remote{mod=Mod,name=Name}) ->
2118    ordsets:from_list([V || #k_var{name=V} <- [Mod,Name]]);
2119op_vars(#k_internal{}) -> [];
2120op_vars(Atomic) -> lit_vars(Atomic).
2121
2122%% lit_vars(Literal) -> [VarName].
2123%%  Return the variables in a literal.
2124
2125lit_vars(#k_var{name=N}) -> [N];
2126%%lit_vars(#k_char{}) -> [];
2127lit_vars(#k_cons{hd=H,tl=T}) ->
2128    union(lit_vars(H), lit_vars(T));
2129lit_vars(#k_map{var=Var,es=Es}) ->
2130    lit_list_vars([Var|Es]);
2131lit_vars(#k_map_pair{key=K,val=V}) ->
2132    union(lit_vars(K), lit_vars(V));
2133lit_vars(#k_binary{segs=V}) -> lit_vars(V);
2134lit_vars(#k_bin_end{}) -> [];
2135lit_vars(#k_bin_seg{size=Size,seg=S,next=N}) ->
2136    union(lit_vars(Size), union(lit_vars(S), lit_vars(N)));
2137lit_vars(#k_tuple{es=Es}) ->
2138    lit_list_vars(Es);
2139lit_vars(#k_literal{}) -> [].
2140
2141lit_list_vars(Ps) ->
2142    foldl(fun (P, Vs) -> union(lit_vars(P), Vs) end, [], Ps).
2143
2144%% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}.
2145%%  Return variables in a pattern.  All variables are new variables
2146%%  except those in the size field of binary segments and the key
2147%%  field in map_pairs.
2148
2149pat_vars(#k_var{name=N}) -> {[],[N]};
2150%%pat_vars(#k_char{}) -> {[],[]};
2151pat_vars(#k_literal{}) -> {[],[]};
2152pat_vars(#k_cons{hd=H,tl=T}) ->
2153    pat_list_vars([H,T]);
2154pat_vars(#k_binary{segs=V}) ->
2155    pat_vars(V);
2156pat_vars(#k_bin_seg{size=Size,seg=S,next=N}) ->
2157    {U1,New} = pat_list_vars([S,N]),
2158    {[],U2} = pat_vars(Size),
2159    {union(U1, U2),New};
2160pat_vars(#k_bin_int{size=Size,next=N}) ->
2161    {[],New} = pat_vars(N),
2162    {[],U} = pat_vars(Size),
2163    {U,New};
2164pat_vars(#k_bin_end{}) -> {[],[]};
2165pat_vars(#k_tuple{es=Es}) ->
2166    pat_list_vars(Es);
2167pat_vars(#k_map{es=Es}) ->
2168    pat_list_vars(Es);
2169pat_vars(#k_map_pair{key=K,val=V}) ->
2170    {U1,New} = pat_vars(V),
2171    {[], U2} = pat_vars(K),
2172    {union(U1,U2),New}.
2173
2174pat_list_vars(Ps) ->
2175    foldl(fun (P, {Used0,New0}) ->
2176		  {Used,New} = pat_vars(P),
2177		  {union(Used0, Used),union(New0, New)} end,
2178	  {[],[]}, Ps).
2179
2180%% List of integers in interval [N,M]. Empty list if N > M.
2181
2182integers(N, M) when N =< M ->
2183    [N|integers(N + 1, M)];
2184integers(_, _) -> [].
2185
2186%%%
2187%%% Handling of errors and warnings.
2188%%%
2189
2190-type error() :: {'failed' | 'nomatch', term()}.
2191
2192-spec format_error(error()) -> string().
2193
2194format_error({nomatch,{shadow,Line}}) ->
2195    M = io_lib:format("this clause cannot match because a previous clause at line ~p "
2196		      "always matches", [Line]),
2197    flatten(M);
2198format_error({nomatch,shadow}) ->
2199    "this clause cannot match because a previous clause always matches";
2200format_error({failed,bad_call}) ->
2201    "invalid module and/or function name; this call will always fail";
2202format_error({failed,bad_segment_size}) ->
2203    "binary construction will fail because the size of a segment is invalid".
2204
2205add_warning(none, Term, Anno, #kern{ws=Ws}=St) ->
2206    File = get_file(Anno),
2207    St#kern{ws=[{File,[{none,?MODULE,Term}]}|Ws]};
2208add_warning(Line, Term, Anno, #kern{ws=Ws}=St) ->
2209    File = get_file(Anno),
2210    St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}.
2211
2212is_compiler_generated(Ke) ->
2213    Anno = get_kanno(Ke),
2214    member(compiler_generated, Anno).
2215