~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

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