← Back to branch summary

~clint-fewbar/ubuntu/precise/erlang/merge-15b

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl

  • Committer: Package Import Robot
  • Author(s): Sergei Golovan
  • Date: 2011-12-15 19:20:10 UTC
  • mfrom: (1.1.18) (3.5.15 sid)
  • mto: (3.5.16 sid)
  • mto: This revision was merged to the branch mainline in revision 33.
  • Revision ID: package-import@ubuntu.com-20111215192010-jnxcfe3tbrpp0big
Tags: 1:15.b-dfsg-1
* New upstream release.
* Upload to experimental because this release breaks external drivers
  API along with ABI, so several applications are to be fixed.
* Removed SSL patch because the old SSL implementation is removed from
  the upstream distribution.
* Removed never used patch which added native code to erlang beam files.
* Removed the erlang-docbuilder binary package because the docbuilder
  application was dropped by upstream.
* Documented dropping ${erlang-docbuilder:Depends} substvar in
  erlang-depends(1) manpage.
* Made erlang-base and erlang-base-hipe provide virtual package
  erlang-abi-15.b (the number means the first erlang version, which
  provides current ABI).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl
 
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: sys_pre_expand.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $
 
17
%%
 
18
%% Purpose : Expand some source Erlang constructions. This is part of the
 
19
%%           pre-processing phase.
 
20
 
 
21
%% N.B. Although structs (tagged tuples) are not yet allowed in the
 
22
%% language there is code included in pattern/2 and expr/3 (commented out)
 
23
%% that handles them by transforming them to tuples.
 
24
 
 
25
-module(sys_pre_expand).
 
26
 
 
27
%% Main entry point.
 
28
-export([module/2]).
 
29
 
 
30
-import(ordsets, [from_list/1,add_element/2,
 
31
                  union/1,union/2,intersection/1,intersection/2,subtract/2]).
 
32
-import(lists,   [member/2,map/2,foldl/3,foldr/3,sort/1,reverse/1,duplicate/2]).
 
33
 
 
34
-include("../my_include/erl_bits.hrl").
 
35
 
 
36
-record(expand, {module=[],                     %Module name
 
37
                 parameters=undefined,          %Module parameters
 
38
                 package="",                    %Module package
 
39
                 exports=[],                    %Exports
 
40
                 imports=[],                    %Imports
 
41
                 mod_imports,                   %Module Imports
 
42
                 compile=[],                    %Compile flags
 
43
                 records=dict:new(),            %Record definitions
 
44
                 attributes=[],                 %Attributes
 
45
                 defined=[],                    %Defined functions
 
46
                 vcount=0,                      %Variable counter
 
47
                 func=[],                       %Current function
 
48
                 arity=[],                      %Arity for current function
 
49
                 fcount=0,                      %Local fun count
 
50
                 fun_index=0,                   %Global index for funs
 
51
                 bitdefault,
 
52
                 bittypes
 
53
                }).
 
54
 
 
55
%% module(Forms, CompileOptions)
 
56
%%      {ModuleName,Exports,TransformedForms}
 
57
%%  Expand the forms in one module. N.B.: the lists of predefined
 
58
%%  exports and imports are really ordsets!
 
59
 
 
60
module(Fs, Opts) ->
 
61
    %% Set pre-defined exported functions.
 
62
    PreExp = [{module_info,0},{module_info,1}],
 
63
 
 
64
    %% Set pre-defined module imports.
 
65
    PreModImp = [{erlang,erlang},{packages,packages}],
 
66
 
 
67
    %% Build initial expand record.
 
68
    St0 = #expand{exports=PreExp,
 
69
                  mod_imports=dict:from_list(PreModImp),
 
70
                  compile=Opts,
 
71
                  defined=PreExp,
 
72
                  bitdefault = erl_bits:system_bitdefault(),
 
73
                  bittypes = erl_bits:system_bittypes()
 
74
                 },
 
75
    %% Expand the functions.
 
76
    {Tfs,St1} = forms(Fs, foldl(fun define_function/2, St0, Fs)),
 
77
    {Efs,St2} = expand_pmod(Tfs, St1),
 
78
    %% Get the correct list of exported functions.
 
79
    Exports = case member(export_all, St2#expand.compile) of
 
80
                  true -> St2#expand.defined;
 
81
                  false -> St2#expand.exports
 
82
              end,
 
83
    %% Generate all functions from stored info.
 
84
    {Ats,St3} = module_attrs(St2#expand{exports = Exports}),
 
85
    {Mfs,St4} = module_predef_funcs(St3),
 
86
    {St4#expand.module, St4#expand.exports, Ats ++ Efs ++ Mfs,
 
87
     St4#expand.compile}.
 
88
 
 
89
expand_pmod(Fs0, St) ->
 
90
    case St#expand.parameters of
 
91
        undefined ->
 
92
            {Fs0,St};
 
93
        Ps ->
 
94
            {Fs1,Xs,Ds} = sys_expand_pmod:forms(Fs0, Ps,
 
95
                                                St#expand.exports,
 
96
                                                St#expand.defined),
 
97
            A = length(Ps),
 
98
            Vs = [{var,0,V} || V <- Ps],
 
99
            N = {atom,0,St#expand.module},
 
100
            B = [{tuple,0,[N|Vs]}],
 
101
            F = {function,0,new,A,[{clause,0,Vs,[],B}]},
 
102
            As = St#expand.attributes,
 
103
            {[F|Fs1],St#expand{exports=add_element({new,A}, Xs),
 
104
                               defined=add_element({new,A}, Ds),
 
105
                               attributes = [{abstract, true} | As]}}
 
106
    end.
 
107
 
 
108
%% -type define_function(Form, State) -> State.
 
109
%%  Add function to defined if form a function.
 
110
 
 
111
define_function({function,_,N,A,_Cs}, St) ->
 
112
    St#expand{defined=add_element({N,A}, St#expand.defined)};
 
113
define_function(_, St) -> St.
 
114
 
 
115
module_attrs(St) ->
 
116
    {[{attribute,0,Name,Val} || {Name,Val} <- St#expand.attributes],St}.
 
117
 
 
118
module_predef_funcs(St) ->
 
119
    PreDef = [{module_info,0},{module_info,1}],
 
120
    PreExp = PreDef,
 
121
    {[{function,0,module_info,0,
 
122
       [{clause,0,[],[],
 
123
        [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
 
124
          [{atom,0,St#expand.module}]}]}]},
 
125
      {function,0,module_info,1,
 
126
       [{clause,0,[{var,0,'X'}],[],
 
127
        [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
 
128
          [{atom,0,St#expand.module},{var,0,'X'}]}]}]}],
 
129
     St#expand{defined=union(from_list(PreDef), St#expand.defined),
 
130
               exports=union(from_list(PreExp), St#expand.exports)}}.
 
131
 
 
132
%% forms(Forms, State) ->
 
133
%%      {TransformedForms,State'}
 
134
%%  Process the forms. Attributes are lost and just affect the state.
 
135
%%  Ignore uninteresting forms like eof and type.
 
136
 
 
137
forms([{attribute,_,Name,Val}|Fs0], St0) ->
 
138
    St1 = attribute(Name, Val, St0),
 
139
    forms(Fs0, St1);
 
140
forms([{function,L,N,A,Cs}|Fs0], St0) ->
 
141
    {Ff,St1} = function(L, N, A, Cs, St0),
 
142
    {Fs,St2} = forms(Fs0, St1),
 
143
    {[Ff|Fs],St2};
 
144
forms([_|Fs], St) -> forms(Fs, St);
 
145
forms([], St) -> {[],St}.
 
146
 
 
147
%% -type attribute(Attribute, Value, State) ->
 
148
%%      State.
 
149
%%  Process an attribute, this just affects the state.
 
150
 
 
151
attribute(module, {Module, As}, St) ->
 
152
    M = package_to_string(Module),
 
153
    St#expand{module=list_to_atom(M),
 
154
              package = packages:strip_last(M),
 
155
              parameters=As};
 
156
attribute(module, Module, St) ->
 
157
    M = package_to_string(Module),
 
158
    St#expand{module=list_to_atom(M),
 
159
              package = packages:strip_last(M)};
 
160
attribute(export, Es, St) ->
 
161
    St#expand{exports=union(from_list(Es), St#expand.exports)};
 
162
attribute(import, Is, St) ->
 
163
    import(Is, St);
 
164
attribute(compile, C, St) when list(C) ->
 
165
    St#expand{compile=St#expand.compile ++ C};
 
166
attribute(compile, C, St) ->
 
167
    St#expand{compile=St#expand.compile ++ [C]};
 
168
attribute(record, {Name,Defs}, St) ->
 
169
    St#expand{records=dict:store(Name, normalise_fields(Defs),
 
170
                                 St#expand.records)};
 
171
attribute(file, _File, St) -> St;               %This is ignored
 
172
attribute(Name, Val, St) when list(Val) ->
 
173
    St#expand{attributes=St#expand.attributes ++ [{Name,Val}]};
 
174
attribute(Name, Val, St) ->
 
175
    St#expand{attributes=St#expand.attributes ++ [{Name,[Val]}]}.
 
176
 
 
177
function(L, N, A, Cs0, St0) ->
 
178
    {Cs,St} = clauses(Cs0, St0#expand{func=N,arity=A,fcount=0}),
 
179
    {{function,L,N,A,Cs},St}.
 
180
 
 
181
%% -type clauses([Clause], State) ->
 
182
%%      {[TransformedClause],State}.
 
183
%%  Expand function clauses.
 
184
 
 
185
clauses([{clause,Line,H0,G0,B0}|Cs0], St0) ->
 
186
    {H,Hvs,_Hus,St1} = head(H0, St0),
 
187
    {G,Gvs,_Gus,St2} = guard(G0, Hvs, St1),
 
188
    {B,_Bvs,_Bus,St3} = exprs(B0, union(Hvs, Gvs), St2),
 
189
    {Cs,St4} = clauses(Cs0, St3),
 
190
    {[{clause,Line,H,G,B}|Cs],St4};
 
191
clauses([], St) -> {[],St}.
 
192
 
 
193
%% head(HeadPatterns, State) ->
 
194
%%      {TransformedPatterns,Variables,UsedVariables,State'}
 
195
 
 
196
head(As, St) -> pattern_list(As, St).
 
197
 
 
198
%% pattern(Pattern, State) ->
 
199
%%      {TransformedPattern,Variables,UsedVariables,State'}
 
200
%% BITS: added used variables for bit patterns with varaible length
 
201
%%
 
202
 
 
203
pattern({var,_,'_'}=Var, St) ->                 %Ignore anonymous variable.
 
204
    {Var,[],[],St};
 
205
pattern({var,_,V}=Var, St) ->
 
206
    {Var,[V],[],St};
 
207
pattern({char,_,_}=Char, St) ->
 
208
    {Char,[],[],St};
 
209
pattern({integer,_,_}=Int, St) ->
 
210
    {Int,[],[],St};
 
211
pattern({float,_,_}=Float, St) ->
 
212
    {Float,[],[],St};
 
213
pattern({atom,_,_}=Atom, St) ->
 
214
    {Atom,[],[],St};
 
215
pattern({string,_,_}=String, St) ->
 
216
    {String,[],[],St};
 
217
pattern({nil,_}=Nil, St) ->
 
218
    {Nil,[],[],St};
 
219
pattern({cons,Line,H,T}, St0) ->
 
220
    {TH,THvs,Hus,St1} = pattern(H, St0),
 
221
    {TT,TTvs,Tus,St2} = pattern(T, St1),
 
222
    {{cons,Line,TH,TT},union(THvs, TTvs),union(Hus,Tus),St2};
 
223
pattern({tuple,Line,Ps}, St0) ->
 
224
    {TPs,TPsvs,Tus,St1} = pattern_list(Ps, St0),
 
225
    {{tuple,Line,TPs},TPsvs,Tus,St1};
 
226
%%pattern({struct,Line,Tag,Ps}, St0) ->
 
227
%%    {TPs,TPsvs,St1} = pattern_list(Ps, St0),
 
228
%%    {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1};
 
229
pattern({record_field,_,_,_}=M, St) ->
 
230
    {expand_package(M, St), [], [], St};  % must be a package name
 
231
pattern({record_index,Line,Name,Field}, St) ->
 
232
    {index_expr(Line, Field, Name, record_fields(Name, St)),[],[],St};
 
233
pattern({record,Line,Name,Pfs}, St0) ->
 
234
    Fs = record_fields(Name, St0),
 
235
    {TMs,TMsvs,Us,St1} = pattern_list(pattern_fields(Fs, Pfs), St0),
 
236
    {{tuple,Line,[{atom,Line,Name}|TMs]},TMsvs,Us,St1};
 
237
pattern({bin,Line,Es0}, St0) ->
 
238
    {Es1,Esvs,Esus,St1} = pattern_bin(Es0, St0),
 
239
    {{bin,Line,Es1},Esvs,Esus,St1};
 
240
pattern({op,_,'++',{nil,_},R}, St) ->
 
241
    pattern(R, St);
 
242
pattern({op,_,'++',{cons,Li,H,T},R}, St) ->
 
243
    pattern({cons,Li,H,{op,Li,'++',T,R}}, St);
 
244
pattern({op,_,'++',{string,Li,L},R}, St) ->
 
245
    pattern(string_to_conses(Li, L, R), St);
 
246
pattern({match,Line,Pat1, Pat2}, St0) ->
 
247
    {TH,Hvt,Hus,St1} = pattern(Pat2, St0),
 
248
    {TT,Tvt,Tus,St2} = pattern(Pat1, St1),
 
249
    {{match,Line,TT,TH}, union(Hvt,Tvt), union(Hus,Tus), St2};
 
250
%% Compile-time pattern expressions, including unary operators.
 
251
pattern({op,Line,Op,A}, St) ->
 
252
    { erl_eval:partial_eval({op,Line,Op,A}), [], [], St};
 
253
pattern({op,Line,Op,L,R}, St) ->
 
254
    { erl_eval:partial_eval({op,Line,Op,L,R}), [], [], St}.
 
255
 
 
256
pattern_list([P0|Ps0], St0) ->
 
257
    {P,Pvs,Pus,St1} = pattern(P0, St0),
 
258
    {Ps,Psvs,Psus,St2} = pattern_list(Ps0, St1),
 
259
    {[P|Ps],union(Pvs, Psvs),union(Pus, Psus),St2};
 
260
pattern_list([], St) -> {[],[],[],St}.
 
261
 
 
262
%% guard(Guard, VisibleVariables, State) ->
 
263
%%      {TransformedGuard,NewVariables,UsedVariables,State'}
 
264
%%  Transform a list of guard tests. We KNOW that this has been checked
 
265
%%  and what the guards test are. Use expr for transforming the guard
 
266
%%  expressions.
 
267
 
 
268
guard([G0|Gs0], Vs, St0) ->
 
269
    {G,Hvs,Hus,St1} = guard_tests(G0, Vs, St0),
 
270
    {Gs,Tvs,Tus,St2} = guard(Gs0, Vs, St1),
 
271
    {[G|Gs],union(Hvs, Tvs),union(Hus, Tus),St2};
 
272
guard([], _, St) -> {[],[],[],St}.
 
273
 
 
274
guard_tests([Gt0|Gts0], Vs, St0) ->
 
275
    {Gt1,Gvs,Gus,St1} = guard_test(Gt0, Vs, St0),
 
276
    {Gts1,Gsvs,Gsus,St2} = guard_tests(Gts0, union(Gvs, Vs), St1),
 
277
    {[Gt1|Gts1],union(Gvs, Gsvs),union(Gus, Gsus),St2};
 
278
guard_tests([], _, St) -> {[],[],[],St}.
 
279
 
 
280
guard_test({call,Line,{atom,_,record},[A,{atom,_,Name}]}, Vs, St) ->
 
281
    record_test_in_guard(Line, A, Name, Vs, St);
 
282
guard_test({call,Line,{atom,Lt,Tname},As}, Vs, St) ->
 
283
    %% XXX This is ugly. We can remove this workaround if/when
 
284
    %% we'll allow 'andalso' in guards. For now, we must have
 
285
    %% different code in guards and in bodies.
 
286
    Test = {remote,Lt,
 
287
            {atom,Lt,erlang},
 
288
            {atom,Lt,normalise_test(Tname, length(As))}},
 
289
    put(sys_pre_expand_in_guard, yes),
 
290
    R = expr({call,Line,Test,As}, Vs, St),
 
291
    erase(sys_pre_expand_in_guard),
 
292
    R;
 
293
guard_test(Test, Vs, St) ->
 
294
    %% XXX See the previous clause.
 
295
    put(sys_pre_expand_in_guard, yes),
 
296
    R = expr(Test, Vs, St),
 
297
    erase(sys_pre_expand_in_guard),
 
298
    R.
 
299
 
 
300
%% record_test(Line, Term, Name, Vs, St) -> TransformedExpr
 
301
%%  Generate code for is_record/1.
 
302
 
 
303
record_test(Line, Term, Name, Vs, St) ->
 
304
    case get(sys_pre_expand_in_guard) of
 
305
        undefined ->
 
306
            record_test_in_body(Line, Term, Name, Vs, St);
 
307
        yes ->
 
308
            record_test_in_guard(Line, Term, Name, Vs, St)
 
309
    end.
 
310
 
 
311
record_test_in_guard(Line, Term, Name, Vs, St) ->
 
312
    %% Notes: (1) To keep is_record/3 properly atomic (e.g. when inverted
 
313
    %%            using 'not'), we cannot convert it to an instruction
 
314
    %%            sequence here. It must remain a single call.
 
315
    %%        (2) Later passes assume that the last argument (the size)
 
316
    %%            is a literal.
 
317
    %%        (3) We don't want calls to erlang:is_record/3 (in the source code)
 
318
    %%            confused we the internal instruction. (Reason: (2) above +
 
319
    %%            code bloat.)
 
320
    %%        (4) Xref may be run on the abstract code, so the name in the
 
321
    %%            abstract code must be erlang:is_record/3.
 
322
    %%        (5) To achive both (3) and (4) at the same time, set the name
 
323
    %%            here to erlang:is_record/3, but mark it as compiler-generated.
 
324
    %%            The v3_core pass will change the name to erlang:internal_is_record/3.
 
325
    Fs = record_fields(Name, St),
 
326
    expr({call,-Line,{remote,-Line,{atom,-Line,erlang},{atom,-Line,is_record}},
 
327
          [Term,{atom,Line,Name},{integer,Line,length(Fs)+1}]},
 
328
         Vs, St).
 
329
 
 
330
record_test_in_body(Line, Expr, Name, Vs, St0) ->
 
331
    %% As Expr may have side effects, we must evaluate it
 
332
    %% first and bind the value to a new variable.
 
333
    %% We must use also handle the case that Expr does not
 
334
    %% evaluate to a tuple properly.
 
335
    Fs = record_fields(Name, St0),
 
336
    {Var,St} = new_var(Line, St0),
 
337
 
 
338
    expr({block,Line,
 
339
          [{match,Line,Var,Expr},
 
340
           {op,Line,
 
341
            'andalso',
 
342
            {call,Line,{atom,Line,is_tuple},[Var]},
 
343
            {op,Line,'andalso',
 
344
             {op,Line,'=:=',
 
345
              {call,Line,{atom,Line,size},[Var]},
 
346
              {integer,Line,length(Fs)+1}},
 
347
             {op,Line,'=:=',
 
348
              {call,Line,{atom,Line,element},[{integer,Line,1},Var]},
 
349
              {atom,Line,Name}}}}]}, Vs, St).
 
350
 
 
351
normalise_test(atom, 1)      -> is_atom;
 
352
normalise_test(binary, 1)    -> is_binary;
 
353
normalise_test(constant, 1)  -> is_constant;
 
354
normalise_test(float, 1)     -> is_float;
 
355
normalise_test(function, 1)  -> is_function;
 
356
normalise_test(integer, 1)   -> is_integer;
 
357
normalise_test(list, 1)      -> is_list;
 
358
normalise_test(number, 1)    -> is_number;
 
359
normalise_test(pid, 1)       -> is_pid;
 
360
normalise_test(port, 1)      -> is_port;
 
361
normalise_test(reference, 1) -> is_reference;
 
362
normalise_test(tuple, 1)     -> is_tuple;
 
363
normalise_test(Name, _) -> Name.
 
364
 
 
365
%% exprs(Expressions, VisibleVariables, State) ->
 
366
%%      {TransformedExprs,NewVariables,UsedVariables,State'}
 
367
 
 
368
exprs([E0|Es0], Vs, St0) ->
 
369
    {E,Evs,Eus,St1} = expr(E0, Vs, St0),
 
370
    {Es,Esvs,Esus,St2} = exprs(Es0, union(Evs, Vs), St1),
 
371
    {[E|Es],union(Evs, Esvs),union(Eus, Esus),St2};
 
372
exprs([], _, St) -> {[],[],[],St}.
 
373
 
 
374
%% expr(Expression, VisibleVariables, State) ->
 
375
%%      {TransformedExpression,NewVariables,UsedVariables,State'}
 
376
 
 
377
expr({var,_,V}=Var, _Vs, St) ->
 
378
    {Var,[],[V],St};
 
379
expr({char,_,_}=Char, _Vs, St) ->
 
380
    {Char,[],[],St};
 
381
expr({integer,_,_}=Int, _Vs, St) ->
 
382
    {Int,[],[],St};
 
383
expr({float,_,_}=Float, _Vs, St) ->
 
384
    {Float,[],[],St};
 
385
expr({atom,_,_}=Atom, _Vs, St) ->
 
386
    {Atom,[],[],St};
 
387
expr({string,_,_}=String, _Vs, St) ->
 
388
    {String,[],[],St};
 
389
expr({nil,_}=Nil, _Vs, St) ->
 
390
    {Nil,[],[],St};
 
391
expr({cons,Line,H0,T0}, Vs, St0) ->
 
392
    {H,Hvs,Hus,St1} = expr(H0, Vs, St0),
 
393
    {T,Tvs,Tus,St2} = expr(T0, Vs, St1),
 
394
    {{cons,Line,H,T},union(Hvs, Tvs),union(Hus, Tus),St2};
 
395
expr({lc,Line,E0,Qs0}, Vs, St0) ->
 
396
    {E1,Qs1,_,Lvs,Lus,St1} = lc_tq(Line, E0, Qs0, {nil,Line}, Vs, St0),
 
397
    {{lc,Line,E1,Qs1},Lvs,Lus,St1};
 
398
expr({tuple,Line,Es0}, Vs, St0) ->
 
399
    {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0),
 
400
    {{tuple,Line,Es1},Esvs,Esus,St1};
 
401
%%expr({struct,Line,Tag,Es0}, Vs, St0) ->
 
402
%%    {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0),
 
403
%%    {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1};
 
404
expr({record_field,_,_,_}=M, _Vs, St) ->
 
405
    {expand_package(M, St), [], [], St};  % must be a package name
 
406
expr({record_index,Line,Name,F}, Vs, St) ->
 
407
    I = index_expr(Line, F, Name, record_fields(Name, St)),
 
408
    expr(I, Vs, St);
 
409
expr({record,Line,Name,Is}, Vs, St) ->
 
410
    expr({tuple,Line,[{atom,Line,Name}|
 
411
                      record_inits(record_fields(Name, St), Is)]},
 
412
         Vs, St);
 
413
expr({record_field,Line,R,Name,F}, Vs, St) ->
 
414
    I = index_expr(Line, F, Name, record_fields(Name, St)),
 
415
    expr({call,Line,{atom,Line,element},[I,R]}, Vs, St);
 
416
expr({record,_,R,Name,Us}, Vs, St0) ->
 
417
    {Ue,St1} = record_update(R, Name, record_fields(Name, St0), Us, St0),
 
418
    expr(Ue, Vs, St1);
 
419
expr({bin,Line,Es0}, Vs, St0) ->
 
420
    {Es1,Esvs,Esus,St1} = expr_bin(Es0, Vs, St0),
 
421
    {{bin,Line,Es1},Esvs,Esus,St1};
 
422
expr({block,Line,Es0}, Vs, St0) ->
 
423
    {Es,Esvs,Esus,St1} = exprs(Es0, Vs, St0),
 
424
    {{block,Line,Es},Esvs,Esus,St1};
 
425
expr({'if',Line,Cs0}, Vs, St0) ->
 
426
    {Cs,Csvss,Csuss,St1} = icr_clauses(Cs0, Vs, St0),
 
427
    All = new_in_all(Vs, Csvss),
 
428
    {{'if',Line,Cs},All,union(Csuss),St1};
 
429
expr({'case',Line,E0,Cs0}, Vs, St0) ->
 
430
    {E,Evs,Eus,St1} = expr(E0, Vs, St0),
 
431
    {Cs,Csvss,Csuss,St2} = icr_clauses(Cs0, union(Evs, Vs), St1),
 
432
    All = new_in_all(Vs, Csvss),
 
433
    {{'case',Line,E,Cs},union(Evs, All),union([Eus|Csuss]),St2};
 
434
expr({'cond',Line,Cs}, Vs, St0) ->
 
435
    {V,St1} = new_var(Line,St0),
 
436
    expr(cond_clauses(Cs,V), Vs, St1);
 
437
expr({'receive',Line,Cs0}, Vs, St0) ->
 
438
    {Cs,Csvss,Csuss,St1} = icr_clauses(Cs0, Vs, St0),
 
439
    All = new_in_all(Vs, Csvss),
 
440
    {{'receive',Line,Cs},All,union(Csuss),St1};
 
441
expr({'receive',Line,Cs0,To0,ToEs0}, Vs, St0) ->
 
442
    {To,Tovs,Tous,St1} = expr(To0, Vs, St0),
 
443
    {ToEs,ToEsvs,_ToEsus,St2} = exprs(ToEs0, Vs, St1),
 
444
    {Cs,Csvss,Csuss,St3} = icr_clauses(Cs0, Vs, St2),
 
445
    All = new_in_all(Vs, [ToEsvs|Csvss]),
 
446
    {{'receive',Line,Cs,To,ToEs},union(Tovs, All),union([Tous|Csuss]),St3};
 
447
expr({'fun',Line,Body}, Vs, St) ->
 
448
    fun_tq(Line, Body, Vs, St);
 
449
%%% expr({call,_,{atom,La,this_module},[]}, _Vs, St) ->
 
450
%%%     {{atom,La,St#expand.module}, [], [], St};
 
451
%%% expr({call,_,{atom,La,this_package},[]}, _Vs, St) ->
 
452
%%%     {{atom,La,list_to_atom(St#expand.package)}, [], [], St};
 
453
%%% expr({call,_,{atom,La,this_package},[{atom,_,Name}]}, _Vs, St) ->
 
454
%%%     M = packages:concat(St#expand.package,Name),
 
455
%%%     {{atom,La,list_to_atom(M)}, [], [], St};
 
456
%%% expr({call,Line,{atom,La,this_package},[A]}, Vs, St) ->
 
457
%%%     M = {call,Line,{remote,La,{atom,La,packages},{atom,La,concat}},
 
458
%%%      [{string,La,St#expand.package}, A]},
 
459
%%%     expr({call,Line,{atom,Line,list_to_atom},[M]}, Vs, St);
 
460
expr({call,Line,{atom,_,is_record},[A,{atom,_,Name}]}, Vs, St) ->
 
461
    record_test(Line, A, Name, Vs, St);
 
462
expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}},
 
463
      [A,{atom,_,Name}]}, Vs, St) ->
 
464
    record_test(Line, A, Name, Vs, St);
 
465
expr({call,Line,{atom,La,N},As0}, Vs, St0) ->
 
466
    {As,Asvs,Asus,St1} = expr_list(As0, Vs, St0),
 
467
    Ar = length(As),
 
468
    case erl_internal:bif(N, Ar) of
 
469
        true ->
 
470
            {{call,Line,{remote,La,{atom,La,erlang},{atom,La,N}},As},
 
471
             Asvs,Asus,St1};
 
472
        false ->
 
473
            case imported(N, Ar, St1) of
 
474
                {yes,Mod} ->
 
475
                    {{call,Line,{remote,La,{atom,La,Mod},{atom,La,N}},As},
 
476
                     Asvs,Asus,St1};
 
477
                no ->
 
478
                    case {N,Ar} of
 
479
                        {record_info,2} ->
 
480
                            record_info_call(Line, As, St1);
 
481
                        _ ->
 
482
                            {{call,Line,{atom,La,N},As},Asvs,Asus,St1}
 
483
                    end
 
484
            end
 
485
    end;
 
486
expr({call,Line,{record_field,_,_,_}=M,As0}, Vs, St0) ->
 
487
    expr({call,Line,expand_package(M, St0),As0}, Vs, St0);
 
488
expr({call,Line,{remote,Lr,M,F},As0}, Vs, St0) ->
 
489
    M1 = expand_package(M, St0),
 
490
    {[M2,F1|As1],Asvs,Asus,St1} = expr_list([M1,F|As0], Vs, St0),
 
491
    {{call,Line,{remote,Lr,M2,F1},As1},Asvs,Asus,St1};
 
492
expr({call,Line,{tuple,_,[{atom,_,_}=M,{atom,_,_}=F]},As}, Vs, St) ->
 
493
    %% Rewrite {Mod,Function}(Args...) to Mod:Function(Args...).
 
494
    expr({call,Line,{remote,Line,M,F},As}, Vs, St);
 
495
expr({call,Line,F,As0}, Vs, St0) ->
 
496
    {[Fun1|As1],Asvs,Asus,St1} = expr_list([F|As0], Vs, St0),
 
497
    {{call,Line,Fun1,As1},Asvs,Asus,St1};
 
498
expr({'try',Line,Es0,Scs0,Ccs0,As0}, Vs, St0) ->
 
499
    {Es1,Esvs,Esus,St1} = exprs(Es0, Vs, St0),
 
500
    Cvs = union(Esvs, Vs),
 
501
    {Scs1,Scsvss,Scsuss,St2} = icr_clauses(Scs0, Cvs, St1),
 
502
    {Ccs1,Ccsvss,Ccsuss,St3} = icr_clauses(Ccs0, Cvs, St2),
 
503
    Csvss = Scsvss ++ Ccsvss,
 
504
    Csuss = Scsuss ++ Ccsuss,
 
505
    All = new_in_all(Vs, Csvss),
 
506
    {As1,Asvs,Asus,St4} = exprs(As0, Cvs, St3),
 
507
    {{'try',Line,Es1,Scs1,Ccs1,As1}, union([Asvs,Esvs,All]),
 
508
     union([Esus,Asus|Csuss]), St4};
 
509
expr({'catch',Line,E0}, Vs, St0) ->
 
510
    %% Catch exports no new variables.
 
511
    {E,_Evs,Eus,St1} = expr(E0, Vs, St0),
 
512
    {{'catch',Line,E},[],Eus,St1};
 
513
expr({match,Line,P0,E0}, Vs, St0) ->
 
514
    {E,Evs,Eus,St1} = expr(E0, Vs, St0),
 
515
    {P,Pvs,Pus,St2} = pattern(P0, St1),
 
516
    {{match,Line,P,E},
 
517
     union(subtract(Pvs, Vs), Evs),
 
518
     union(intersection(Pvs, Vs), union(Eus,Pus)),St2};
 
519
expr({op,L,'andalso',E1,E2}, Vs, St0) ->
 
520
    {V,St1} = new_var(L,St0),
 
521
    E = make_bool_switch(L,E1,V,
 
522
                         make_bool_switch(L,E2,V,{atom,L,true},
 
523
                                          {atom,L,false}),
 
524
                         {atom,L,false}),
 
525
    expr(E, Vs, St1);
 
526
expr({op,L,'orelse',E1,E2}, Vs, St0) ->
 
527
    {V,St1} = new_var(L,St0),
 
528
    E = make_bool_switch(L,E1,V,{atom,L,true},
 
529
                         make_bool_switch(L,E2,V,{atom,L,true},
 
530
                                          {atom,L,false})),
 
531
    expr(E, Vs, St1);
 
532
expr({op,Line,'++',{lc,Ll,E0,Qs0},M0}, Vs, St0) ->
 
533
    {E1,Qs1,M1,Lvs,Lus,St1} = lc_tq(Ll, E0, Qs0, M0, Vs, St0),
 
534
    {{op,Line,'++',{lc,Ll,E1,Qs1},M1},Lvs,Lus,St1};
 
535
expr({op,_,'++',{string,L1,S1},{string,_,S2}}, _Vs, St) ->
 
536
    {{string,L1,S1 ++ S2},[],[],St};
 
537
expr({op,Ll,'++',{string,L1,S1}=Str,R0}, Vs, St0) ->
 
538
    {R1,Rvs,Rus,St1} = expr(R0, Vs, St0),
 
539
    E = case R1 of
 
540
            {string,_,S2} -> {string,L1,S1 ++ S2};
 
541
            _Other when length(S1) < 8 -> string_to_conses(L1, S1, R1);
 
542
            _Other -> {op,Ll,'++',Str,R1}
 
543
        end,
 
544
    {E,Rvs,Rus,St1};
 
545
expr({op,Ll,'++',{cons,Lc,H,T},L2}, Vs, St) ->
 
546
    expr({cons,Ll,H,{op,Lc,'++',T,L2}}, Vs, St);
 
547
expr({op,_,'++',{nil,_},L2}, Vs, St) ->
 
548
    expr(L2, Vs, St);
 
549
expr({op,Line,Op,A0}, Vs, St0) ->
 
550
    {A,Avs,Aus,St1} = expr(A0, Vs, St0),
 
551
    {{op,Line,Op,A},Avs,Aus,St1};
 
552
expr({op,Line,Op,L0,R0}, Vs, St0) ->
 
553
    {L,Lvs,Lus,St1} = expr(L0, Vs, St0),
 
554
    {R,Rvs,Rus,St2} = expr(R0, Vs, St1),
 
555
    {{op,Line,Op,L,R},union(Lvs, Rvs),union(Lus, Rus),St2}.
 
556
 
 
557
expr_list([E0|Es0], Vs, St0) ->
 
558
    {E,Evs,Eus,St1} = expr(E0, Vs, St0),
 
559
    {Es,Esvs,Esus,St2} = expr_list(Es0, Vs, St1),
 
560
    {[E|Es],union(Evs, Esvs),union(Eus, Esus),St2};
 
561
expr_list([], _, St) ->
 
562
    {[],[],[],St}.
 
563
 
 
564
%% icr_clauses([Clause], [VisibleVariable], State) ->
 
565
%%      {[TransformedClause],[[NewVariable]],[[UsedVariable]],State'}
 
566
%%  Be very careful here to return the variables that are really used
 
567
%%  and really new.
 
568
 
 
569
icr_clauses([], _, St) ->
 
570
    {[],[[]],[],St};
 
571
icr_clauses(Clauses, Vs, St) ->
 
572
    icr_clauses2(Clauses, Vs, St).
 
573
 
 
574
icr_clauses2([{clause,Line,H0,G0,B0}|Cs0], Vs, St0) ->
 
575
    {H,Hvs,Hus,St1} = head(H0, St0),            %Hvs is really used!
 
576
    {G,Gvs,Gus,St2} = guard(G0, union(Hvs, Vs), St1),
 
577
    {B,Bvs,Bus,St3} = exprs(B0, union([Vs,Hvs,Gvs]), St2),
 
578
    New = subtract(union([Hvs,Gvs,Bvs]), Vs),   %Really new
 
579
    Used = intersection(union([Hvs,Hus,Gus,Bus]), Vs), %Really used
 
580
    {Cs,Csvs,Csus,St4} = icr_clauses2(Cs0, Vs, St3),
 
581
    {[{clause,Line,H,G,B}|Cs],[New|Csvs],[Used|Csus],St4};
 
582
icr_clauses2([], _, St) ->
 
583
    {[],[],[],St}.
 
584
 
 
585
%% lc_tq(Line, Expr, Qualifiers, More, [VisibleVar], State) ->
 
586
%%      {TransExpr,[TransQual],TransMore,[NewVar],[UsedVar],State'}
 
587
 
 
588
lc_tq(Line, E0, [{generate,Lg,P0,G0}|Qs0], M0, Vs, St0) ->
 
589
    {G1,Gvs,Gus,St1} = expr(G0, Vs, St0),
 
590
    {P1,Pvs,Pus,St2} = pattern(P0, St1),
 
591
    {E1,Qs1,M1,Lvs,Lus,St3} = lc_tq(Line, E0, Qs0, M0, union(Pvs, Vs), St2),
 
592
    {E1,[{generate,Lg,P1,G1}|Qs1],M1,
 
593
     union(Gvs, Lvs),union([Gus,Pus,Lus]),St3};
 
594
lc_tq(Line, E0, [F0|Qs0], M0, Vs, St0) ->
 
595
    %% Allow record/2 and expand out as guard test.
 
596
    case erl_lint:is_guard_test(F0) of
 
597
        true ->
 
598
            {F1,Fvs,_Fus,St1} = guard_tests([F0], Vs, St0),
 
599
            {E1,Qs1,M1,Lvs,Lus,St2} = lc_tq(Line, E0, Qs0, M0, union(Fvs, Vs), St1),
 
600
            {E1,F1++Qs1,M1,Lvs,Lus,St2};
 
601
        false ->
 
602
            {F1,Fvs,_Fus,St1} = expr(F0, Vs, St0),
 
603
            {E1,Qs1,M1,Lvs,Lus,St2} = lc_tq(Line, E0, Qs0, M0, union(Fvs, Vs), St1),
 
604
            {E1,[F1|Qs1],M1,Lvs,Lus,St2}
 
605
    end;
 
606
lc_tq(_Line, E0, [], M0, Vs, St0) ->
 
607
    {E1,Evs,Eus,St1} = expr(E0, Vs, St0),
 
608
    {M1,Mvs,Mus,St2} = expr(M0, Vs, St1),
 
609
    {E1,[],M1,union(Evs, Mvs),union(Eus, Mus),St2}.
 
610
 
 
611
%% fun_tq(Line, Body, VisibleVariables, State) ->
 
612
%%      {Fun,NewVariables,UsedVariables,State'}
 
613
%% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an
 
614
%% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the
 
615
%% name of a BIF (erl_lint has checked that it is not an import).
 
616
%% Process the body sequence directly to get the new and used variables.
 
617
%% "Implicit" funs {'fun', Line, {function, F, A}} are not changed.
 
618
 
 
619
fun_tq(Lf, {function,F,A}, Vs, St0) ->
 
620
    {As,St1} = new_vars(A, Lf, St0),
 
621
    Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}],
 
622
    case erl_internal:bif(F, A) of
 
623
        true ->
 
624
            fun_tq(Lf, {clauses,Cs}, Vs, St1);
 
625
        false ->
 
626
            Index = St0#expand.fun_index,
 
627
            Uniq = erlang:hash(Cs, (1 bsl 27)-1),
 
628
            {Fname,St2} = new_fun_name(St1),
 
629
            {{'fun',Lf,{function,F,A},{Index,Uniq,Fname}},[],[],
 
630
             St2#expand{fun_index=Index+1}}
 
631
    end;
 
632
fun_tq(Lf, {clauses,Cs0}, Vs, St0) ->
 
633
    Uniq = erlang:hash(Cs0, (1 bsl 27)-1),
 
634
    {Cs1,_Hvss,Frees,St1} = fun_clauses(Cs0, Vs, St0),
 
635
    Ufrees = union(Frees),
 
636
    Index = St1#expand.fun_index,
 
637
    {Fname,St2} = new_fun_name(St1),
 
638
    {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},[],Ufrees,
 
639
     St2#expand{fun_index=Index+1}}.
 
640
 
 
641
fun_clauses([{clause,L,H0,G0,B0}|Cs0], Vs, St0) ->
 
642
    {H,Hvs,Hus,St1} = head(H0, St0),
 
643
    {G,Gvs,Gus,St2} = guard(G0, union(Hvs, Vs), St1),
 
644
    {B,Bvs,Bus,St3} = exprs(B0, union([Vs,Hvs,Gvs]), St2),
 
645
    %% Free variables cannot be new anywhere in the clause.
 
646
    Free = subtract(union([Gus,Hus,Bus]), union([Hvs,Gvs,Bvs])),
 
647
    %%io:format(" Gus :~p~n Bvs :~p~n Bus :~p~n Free:~p~n" ,[Gus,Bvs,Bus,Free]),
 
648
    {Cs,Hvss,Frees,St4} = fun_clauses(Cs0, Vs, St3),
 
649
    {[{clause,L,H,G,B}|Cs],[Hvs|Hvss],[Free|Frees],St4};
 
650
fun_clauses([], _, St) -> {[],[],[],St}.
 
651
 
 
652
%% new_fun_name(State) -> {FunName,State}.
 
653
 
 
654
new_fun_name(#expand{func=F,arity=A,fcount=I}=St) ->
 
655
    Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A)
 
656
        ++ "-fun-" ++ integer_to_list(I) ++ "-",
 
657
    {list_to_atom(Name),St#expand{fcount=I+1}}.
 
658
 
 
659
 
 
660
%% normalise_fields([RecDef]) -> [Field].
 
661
%%  Normalise the field definitions to always have a default value. If
 
662
%%  none has been given then use 'undefined'.
 
663
 
 
664
normalise_fields(Fs) ->
 
665
    map(fun ({record_field,Lf,Field}) ->
 
666
                {record_field,Lf,Field,{atom,Lf,undefined}};
 
667
            (F) -> F end, Fs).
 
668
 
 
669
%% record_fields(RecordName, State)
 
670
%% find_field(FieldName, Fields)
 
671
 
 
672
record_fields(R, St) -> dict:fetch(R, St#expand.records).
 
673
 
 
674
find_field(F, [{record_field,_,{atom,_,F},Val}|_]) -> {ok,Val};
 
675
find_field(F, [_|Fs]) -> find_field(F, Fs);
 
676
find_field(_, []) -> error.
 
677
 
 
678
%% field_names(RecFields) -> [Name].
 
679
%%  Return a list of the field names structures.
 
680
 
 
681
field_names(Fs) ->
 
682
    map(fun ({record_field,_,Field,_Val}) -> Field end, Fs).
 
683
 
 
684
%% index_expr(Line, FieldExpr, Name, Fields) -> IndexExpr.
 
685
%%  Return an expression which evaluates to the index of a
 
686
%%  field. Currently only handle the case where the field is an
 
687
%%  atom. This expansion must be passed through expr again.
 
688
 
 
689
index_expr(Line, {atom,_,F}, _Name, Fs) ->
 
690
    {integer,Line,index_expr(F, Fs, 2)}.
 
691
 
 
692
index_expr(F, [{record_field,_,{atom,_,F},_}|_], I) -> I;
 
693
index_expr(F, [_|Fs], I) ->
 
694
    index_expr(F, Fs, I+1).
 
695
 
 
696
%% pattern_fields([RecDefField], [Match]) -> [Pattern].
 
697
%%  Build a list of match patterns for the record tuple elements.
 
698
%%  This expansion must be passed through pattern again. N.B. We are
 
699
%%  scanning the record definition field list!
 
700
 
 
701
pattern_fields(Fs, Ms) ->
 
702
    Wildcard = record_wildcard_init(Ms),
 
703
    map(fun ({record_field,L,{atom,_,F},_}) ->
 
704
                case find_field(F, Ms) of
 
705
                    {ok,Match} -> Match;
 
706
                    error when Wildcard =:= none -> {var,L,'_'};
 
707
                    error -> Wildcard
 
708
                end end,
 
709
        Fs).
 
710
 
 
711
%% record_inits([RecDefField], [Init]) -> [InitExpr].
 
712
%%  Build a list of initialisation expressions for the record tuple
 
713
%%  elements. This expansion must be passed through expr
 
714
%%  again. N.B. We are scanning the record definition field list!
 
715
 
 
716
record_inits(Fs, Is) ->
 
717
    WildcardInit = record_wildcard_init(Is),
 
718
    map(fun ({record_field,_,{atom,_,F},D}) ->
 
719
                case find_field(F, Is) of
 
720
                    {ok,Init} -> Init;
 
721
                    error when WildcardInit =:= none -> D;
 
722
                    error -> WildcardInit
 
723
                end end,
 
724
        Fs).
 
725
 
 
726
record_wildcard_init([{record_field,_,{var,_,'_'},D}|_]) -> D;
 
727
record_wildcard_init([_|Is]) -> record_wildcard_init(Is);
 
728
record_wildcard_init([]) -> none.
 
729
 
 
730
%% record_update(Record, RecordName, [RecDefField], [Update], State) ->
 
731
%%      {Expr,State'}
 
732
%%  Build an expression to update fields in a record returning a new
 
733
%%  record.  Try to be smart and optimise this. This expansion must be
 
734
%%  passed through expr again.
 
735
 
 
736
record_update(R, Name, Fs, Us0, St0) ->
 
737
    Line = element(2, R),
 
738
    {Pre,Us,St1} = record_exprs(Us0, St0),
 
739
    Nf = length(Fs),                            %# of record fields
 
740
    Nu = length(Us),                            %# of update fields
 
741
    Nc = Nf - Nu,                               %# of copy fields
 
742
 
 
743
    %% We need a new variable for the record expression
 
744
    %% to guarantee that it is only evaluated once.
 
745
    {Var,St2} = new_var(Line, St1),
 
746
 
 
747
    %% Try to be intelligent about which method of updating record to use.
 
748
    {Update,St} =
 
749
        if
 
750
            Nu == 0 -> {R,St2};                 %No fields updated
 
751
            Nu =< Nc ->                         %Few fields updated
 
752
                {record_setel(Var, Name, Fs, Us), St2};
 
753
            true ->                           %The wide area inbetween
 
754
                record_match(Var, Name, Fs, Us, St2)
 
755
        end,
 
756
    {{block,element(2, R),Pre ++ [{match,Line,Var,R},Update]},St}.
 
757
 
 
758
%% record_match(Record, RecordName, [RecDefField], [Update], State)
 
759
%%  Build a 'case' expression to modify record fields.
 
760
 
 
761
record_match(R, Name, Fs, Us, St0) ->
 
762
    {Ps,News,St1} = record_upd_fs(Fs, Us, St0),
 
763
    Lr = element(2, hd(Us)),
 
764
    {{'case',Lr,R,
 
765
      [{clause,Lr,[{tuple,Lr,[{atom,Lr,Name}|Ps]}],[],
 
766
        [{tuple,Lr,[{atom,Lr,Name}|News]}]},
 
767
       {clause,Lr,[{var,Lr,'_'}],[],
 
768
        [call_error(Lr, {tuple,Lr,[{atom,Lr,badrecord},{atom,Lr,Name}]})]}
 
769
      ]},
 
770
     St1}.
 
771
 
 
772
record_upd_fs([{record_field,Lf,{atom,_La,F},_Val}|Fs], Us, St0) ->
 
773
    {P,St1} = new_var(Lf, St0),
 
774
    {Ps,News,St2} = record_upd_fs(Fs, Us, St1),
 
775
    case find_field(F, Us) of
 
776
        {ok,New} -> {[P|Ps],[New|News],St2};
 
777
        error -> {[P|Ps],[P|News],St2}
 
778
    end;
 
779
record_upd_fs([], _, St) -> {[],[],St}.
 
780
 
 
781
%% record_setel(Record, RecordName, [RecDefField], [Update])
 
782
%%  Build a nested chain of setelement calls to build the
 
783
%%  updated record tuple.
 
784
 
 
785
record_setel(R, Name, Fs, Us0) ->
 
786
    Us1 = foldl(fun ({record_field,Lf,Field,Val}, Acc) ->
 
787
                        I = index_expr(Lf, Field, Name, Fs),
 
788
                        [{I,Lf,Val}|Acc]
 
789
                end, [], Us0),
 
790
    Us = sort(Us1),
 
791
    Lr = element(2, hd(Us)),
 
792
    Wildcards = duplicate(length(Fs), {var,Lr,'_'}),
 
793
    {'case',Lr,R,
 
794
     [{clause,Lr,[{tuple,Lr,[{atom,Lr,Name}|Wildcards]}],[],
 
795
       [foldr(fun ({I,Lf,Val}, Acc) ->
 
796
                      {call,Lf,{atom,Lf,setelement},[I,Acc,Val]} end,
 
797
              R, Us)]},
 
798
      {clause,Lr,[{var,Lr,'_'}],[],
 
799
       [call_error(Lr, {tuple,Lr,[{atom,Lr,badrecord},{atom,Lr,Name}]})]}]}.
 
800
 
 
801
%% Expand a call to record_info/2. We have checked that it is not
 
802
%% shadowed by an import.
 
803
 
 
804
record_info_call(Line, [{atom,_Li,Info},{atom,_Ln,Name}], St) ->
 
805
    case Info of
 
806
        size ->
 
807
            {{integer,Line,1+length(record_fields(Name, St))},[],[],St};
 
808
        fields ->
 
809
            {make_list(field_names(record_fields(Name, St)), Line),
 
810
             [],[],St}
 
811
    end.
 
812
 
 
813
%% Break out expressions from an record update list and bind to new
 
814
%% variables. The idea is that we will evaluate all update expressions
 
815
%% before starting to update the record.
 
816
 
 
817
record_exprs(Us, St) ->
 
818
    record_exprs(Us, St, [], []).
 
819
 
 
820
record_exprs([{record_field,Lf,{atom,_La,_F}=Name,Val}=Field0|Us], St0, Pre, Fs) ->
 
821
    case is_simple_val(Val) of
 
822
        true ->
 
823
            record_exprs(Us, St0, Pre, [Field0|Fs]);
 
824
        false ->
 
825
            {Var,St} = new_var(Lf, St0),
 
826
            Bind = {match,Lf,Var,Val},
 
827
            Field = {record_field,Lf,Name,Var},
 
828
            record_exprs(Us, St, [Bind|Pre], [Field|Fs])
 
829
    end;
 
830
record_exprs([], St, Pre, Fs) ->
 
831
    {reverse(Pre),Fs,St}.
 
832
 
 
833
is_simple_val({var,_,_}) -> true;
 
834
is_simple_val({atom,_,_}) -> true;
 
835
is_simple_val({integer,_,_}) -> true;
 
836
is_simple_val({float,_,_}) -> true;
 
837
is_simple_val({nil,_}) -> true;
 
838
is_simple_val(_) -> false.
 
839
 
 
840
%% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}.
 
841
 
 
842
pattern_bin(Es0, St) ->
 
843
    Es1 = bin_expand_strings(Es0),
 
844
    foldr(fun (E, Acc) -> pattern_element(E, Acc) end, {[],[],[],St}, Es1).
 
845
 
 
846
pattern_element({bin_element,Line,Expr,Size,Type}, {Es,Esvs,Esus,St0}) ->
 
847
    {Expr1,Vs1,Us1,St1} = pattern(Expr, St0),
 
848
    {Size1,Vs2,Us2,St2} = pat_bit_size(Size, St1),
 
849
    {Size2,Type1} = make_bit_type(Line, Size1,Type),
 
850
    {[{bin_element,Line,Expr1,Size2,Type1}|Es],
 
851
      union([Vs1,Vs2,Esvs]),union([Us1,Us2,Esus]),St2}.
 
852
 
 
853
pat_bit_size(default, St) -> {default,[],[],St};
 
854
pat_bit_size({atom,_La,all}=All, St) -> {All,[],[],St};
 
855
pat_bit_size({var,_Lv,V}=Var, St) -> {Var,[],[V],St};
 
856
pat_bit_size(Size, St) ->
 
857
    Line = element(2, Size),
 
858
    {value,Sz,_} = erl_eval:expr(Size, erl_eval:new_bindings()),
 
859
    {{integer,Line,Sz},[],[],St}.
 
860
 
 
861
make_bit_type(Line, default, Type0) ->
 
862
    case erl_bits:set_bit_type(default, Type0) of
 
863
        {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
 
864
        {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}
 
865
    end;
 
866
make_bit_type(_Line, Size, Type0) ->            %Integer or 'all'
 
867
    {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0),
 
868
    {Size,erl_bits:as_list(Bt)}.
 
869
 
 
870
%% expr_bin([Element], [VisibleVar], State) ->
 
871
%%              {[Element],[NewVar],[UsedVar],State}.
 
872
 
 
873
expr_bin(Es0, Vs, St) ->
 
874
    Es1 = bin_expand_strings(Es0),
 
875
    foldr(fun (E, Acc) -> bin_element(E, Vs, Acc) end, {[],[],[],St}, Es1).
 
876
 
 
877
bin_element({bin_element,Line,Expr,Size,Type}, Vs, {Es,Esvs,Esus,St0}) ->
 
878
    {Expr1,Vs1,Us1,St1} = expr(Expr, Vs, St0),
 
879
    {Size1,Vs2,Us2,St2} = if Size == default -> {default,[],[],St1};
 
880
                             true -> expr(Size, Vs, St1)
 
881
                          end,
 
882
    {Size2,Type1} = make_bit_type(Line, Size1, Type),
 
883
    {[{bin_element,Line,Expr1,Size2,Type1}|Es],
 
884
     union([Vs1,Vs2,Esvs]),union([Us1,Us2,Esus]),St2}.
 
885
 
 
886
bin_expand_strings(Es) ->
 
887
    foldr(fun ({bin_element,Line,{string,_,S},default,default}, Es1) ->
 
888
                  foldr(fun (C, Es2) ->
 
889
                                [{bin_element,Line,{char,Line,C},default,default}|Es2]
 
890
                        end, Es1, S);
 
891
              (E, Es1) -> [E|Es1]
 
892
          end, [], Es).
 
893
 
 
894
%% new_var_name(State) -> {VarName,State}.
 
895
 
 
896
new_var_name(St) ->
 
897
    C = St#expand.vcount,
 
898
    {list_to_atom("pre" ++ integer_to_list(C)),St#expand{vcount=C+1}}.
 
899
 
 
900
%% new_var(Line, State) -> {Var,State}.
 
901
 
 
902
new_var(L, St0) ->
 
903
    {New,St1} = new_var_name(St0),
 
904
    {{var,L,New},St1}.
 
905
 
 
906
%% new_vars(Count, Line, State) -> {[Var],State}.
 
907
%%  Make Count new variables.
 
908
 
 
909
new_vars(N, L, St) -> new_vars(N, L, St, []).
 
910
 
 
911
new_vars(N, L, St0, Vs) when N > 0 ->
 
912
    {V,St1} = new_var(L, St0),
 
913
    new_vars(N-1, L, St1, [V|Vs]);
 
914
new_vars(0, _L, St, Vs) -> {Vs,St}.
 
915
 
 
916
%% make_list(TermList, Line) -> ConsTerm.
 
917
 
 
918
make_list(Ts, Line) ->
 
919
    foldr(fun (H, T) -> {cons,Line,H,T} end, {nil,Line}, Ts).
 
920
 
 
921
string_to_conses(Line, Cs, Tail) ->
 
922
    foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs).
 
923
 
 
924
 
 
925
%% In syntax trees, module/package names are atoms or lists of atoms.
 
926
 
 
927
package_to_string(A) when atom(A) -> atom_to_list(A);
 
928
package_to_string(L) when list(L) -> packages:concat(L).
 
929
 
 
930
expand_package({atom,L,A} = M, St) ->
 
931
    case dict:find(A, St#expand.mod_imports) of
 
932
        {ok, A1} ->
 
933
            {atom,L,A1};
 
934
        error ->
 
935
            case packages:is_segmented(A) of
 
936
                true ->
 
937
                    M;
 
938
                false ->
 
939
                    M1 = packages:concat(St#expand.package, A),
 
940
                    {atom,L,list_to_atom(M1)}
 
941
            end
 
942
    end;
 
943
expand_package(M, _St) ->
 
944
    case erl_parse:package_segments(M) of
 
945
        error ->
 
946
            M;
 
947
        M1 ->
 
948
            {atom,element(2,M),list_to_atom(package_to_string(M1))}
 
949
    end.
 
950
 
 
951
%% Create a case-switch on true/false, generating badarg for all other
 
952
%% values.
 
953
 
 
954
make_bool_switch(L, E, V, T, F) ->
 
955
    make_bool_switch_1(L, E, V, [T], [F]).
 
956
 
 
957
make_bool_switch_1(L, E, V, T, F) ->
 
958
    case get(sys_pre_expand_in_guard) of
 
959
        undefined -> make_bool_switch_body(L, E, V, T, F);
 
960
        yes -> make_bool_switch_guard(L, E, V, T, F)
 
961
    end.
 
962
 
 
963
make_bool_switch_guard(_, E, _, [{atom,_,true}], [{atom,_,false}]) -> E;
 
964
make_bool_switch_guard(L, E, V, T, F) ->
 
965
    NegL = -abs(L),
 
966
    {'case',NegL,E,
 
967
     [{clause,NegL,[{atom,NegL,true}],[],T},
 
968
      {clause,NegL,[{atom,NegL,false}],[],F},
 
969
      {clause,NegL,[V],[],[V]}
 
970
     ]}.
 
971
 
 
972
make_bool_switch_body(L, E, V, T, F) ->
 
973
    NegL = -abs(L),
 
974
    {'case',NegL,E,
 
975
     [{clause,NegL,[{atom,NegL,true}],[],T},
 
976
      {clause,NegL,[{atom,NegL,false}],[],F},
 
977
      {clause,NegL,[V],[],
 
978
       [call_error(NegL,{tuple,NegL,[{atom,NegL,badarg},V]})]}
 
979
     ]}.
 
980
 
 
981
%% Expand a list of cond-clauses to a sequence of case-switches.
 
982
 
 
983
cond_clauses([{clause,L,[],[[E]],B}],V) ->
 
984
    make_bool_switch_1(L,E,V,B,[call_error(L,{atom,L,cond_clause})]);
 
985
cond_clauses([{clause,L,[],[[E]],B} | Cs],V) ->
 
986
    make_bool_switch_1(L,E,V,B,[cond_clauses(Cs,V)]).
 
987
 
 
988
%% call_error(Line, Reason) -> Expr.
 
989
%%  Build a call to erlang:error/1 with reason Reason.
 
990
 
 
991
call_error(L, R) ->
 
992
    {call,L,{remote,L,{atom,L,erlang},{atom,L,error}},[R]}.
 
993
 
 
994
%% new_in_all(Before, RegionList) -> NewInAll
 
995
%%  Return the variables new in all clauses.
 
996
 
 
997
new_in_all(Before, Region) ->
 
998
    InAll = intersection(Region),
 
999
    subtract(InAll, Before).
 
1000
 
 
1001
%% import(Line, Imports, State) ->
 
1002
%%      State'
 
1003
%% imported(Name, Arity, State) ->
 
1004
%%      {yes,Module} | no
 
1005
%%  Handle import declarations and est for imported functions. No need to
 
1006
%%  check when building imports as code is correct.
 
1007
 
 
1008
import({Mod0,Fs}, St) ->
 
1009
    Mod = list_to_atom(package_to_string(Mod0)),
 
1010
    Mfs = from_list(Fs),
 
1011
    St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)};
 
1012
import(Mod0, St) ->
 
1013
    Mod = package_to_string(Mod0),
 
1014
    Key = list_to_atom(packages:last(Mod)),
 
1015
    St#expand{mod_imports=dict:store(Key, list_to_atom(Mod),
 
1016
                                     St#expand.mod_imports)}.
 
1017
 
 
1018
add_imports(Mod, [F|Fs], Is) ->
 
1019
    add_imports(Mod, Fs, orddict:store(F, Mod, Is));
 
1020
add_imports(_, [], Is) -> Is.
 
1021
 
 
1022
imported(F, A, St) ->
 
1023
    case orddict:find({F,A}, St#expand.imports) of
 
1024
        {ok,Mod} -> {yes,Mod};
 
1025
        error -> no
 
1026
    end.