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/.
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
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.''
18
%% Purpose : Expand records into tuples.
20
%% N.B. Although structs (tagged tuples) are not yet allowed in the
21
%% language there is code included in pattern/2 and expr/3 (commented out)
24
-module(erl_expand_records).
28
-import(lists, [map/2,foldl/3,foldr/3,sort/1,reverse/1,duplicate/2]).
30
-record(exprec, {compile=[], % Compile flags
31
vcount=0, % Variable counter
33
records=dict:new(), % Record definitions
34
strict_ra=[], % strict record accesses
35
checked_ra=[] % succesfully accessed records
38
%% Is is assumed that Fs is a valid list of forms. It should pass
39
%% erl_lint without errors.
41
Opts = compiler_options(Fs0) ++ Opts0,
42
St0 = #exprec{compile = Opts},
43
{Fs,_St} = forms(Fs0, St0),
46
compiler_options(Forms) ->
47
lists:flatten([C || {attribute,_,compile,C} <- Forms]).
49
forms([{attribute,_L,record,{Name,Defs}} | Fs], St0) ->
50
NDefs = normalise_fields(Defs),
51
St = St0#exprec{records=dict:store(Name, NDefs, St0#exprec.records)},
53
forms([{attribute,L,import,Is} | Fs0], St0) ->
54
St1 = import(Is, St0),
55
{Fs,St2} = forms(Fs0, St1),
56
{[{attribute,L,import,Is} | Fs], St2};
57
forms([{function,L,N,A,Cs0} | Fs0], St0) ->
58
{Cs,St1} = clauses(Cs0, St0),
59
{Fs,St2} = forms(Fs0, St1),
60
{[{function,L,N,A,Cs} | Fs],St2};
61
forms([F | Fs0], St0) ->
62
{Fs,St} = forms(Fs0, St0),
64
forms([], St) -> {[],St}.
66
clauses([{clause,Line,H0,G0,B0} | Cs0], St0) ->
67
{H,St1} = head(H0, St0),
68
{G,St2} = guard(G0, St1),
69
{B,St3} = exprs(B0, St2),
70
{Cs,St4} = clauses(Cs0, St3),
71
{[{clause,Line,H,G,B} | Cs],St4};
72
clauses([], St) -> {[],St}.
74
head(As, St) -> pattern_list(As, St).
76
pattern({var,_,'_'}=Var, St) ->
78
pattern({var,_,_}=Var, St) ->
80
pattern({char,_,_}=Char, St) ->
82
pattern({integer,_,_}=Int, St) ->
84
pattern({float,_,_}=Float, St) ->
86
pattern({atom,_,_}=Atom, St) ->
88
pattern({string,_,_}=String, St) ->
90
pattern({nil,_}=Nil, St) ->
92
pattern({cons,Line,H,T}, St0) ->
93
{TH,St1} = pattern(H, St0),
94
{TT,St2} = pattern(T, St1),
95
{{cons,Line,TH,TT},St2};
96
pattern({tuple,Line,Ps}, St0) ->
97
{TPs,St1} = pattern_list(Ps, St0),
98
{{tuple,Line,TPs},St1};
99
%%pattern({struct,Line,Tag,Ps}, St0) ->
100
%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
101
%% {{struct,Line,Tag,TPs},TPsvs,St1};
102
pattern({record_field,_,_,_}=M, St) ->
103
{M,St}; % must be a package name
104
pattern({record_index,Line,Name,Field}, St) ->
105
{index_expr(Line, Field, Name, record_fields(Name, St)),St};
106
pattern({record,Line,Name,Pfs}, St0) ->
107
Fs = record_fields(Name, St0),
108
{TMs,St1} = pattern_list(pattern_fields(Fs, Pfs), St0),
109
{{tuple,Line,[{atom,Line,Name} | TMs]},St1};
110
pattern({bin,Line,Es0}, St0) ->
111
{Es1,St1} = pattern_bin(Es0, St0),
112
{{bin,Line,Es1},St1};
113
pattern({match,Line,Pat1, Pat2}, St0) ->
114
{TH,St1} = pattern(Pat2, St0),
115
{TT,St2} = pattern(Pat1, St1),
116
{{match,Line,TT,TH},St2};
117
pattern({op,Line,Op,A0}, St0) ->
118
{A,St1} = pattern(A0, St0),
119
{{op,Line,Op,A},St1};
120
pattern({op,Line,Op,L0,R0}, St0) ->
121
{L,St1} = pattern(L0, St0),
122
{R,St2} = pattern(R0, St1),
123
{{op,Line,Op,L,R},St2}.
125
pattern_list([P0 | Ps0], St0) ->
126
{P,St1} = pattern(P0, St0),
127
{Ps,St2} = pattern_list(Ps0, St1),
129
pattern_list([], St) -> {[],St}.
131
guard([G0 | Gs0], St0) ->
132
{G,St1} = guard_tests(G0, St0),
133
{Gs,St2} = guard(Gs0, St1),
135
guard([], St) -> {[],St}.
137
guard_tests(Gts0, St0) ->
138
{Gts1,St1} = guard_tests1(Gts0, St0),
139
{Gts1,St1#exprec{checked_ra = []}}.
141
guard_tests1([Gt0 | Gts0], St0) ->
142
{Gt1,St1} = guard_test(Gt0, St0),
143
{Gts1,St2} = guard_tests1(Gts0, St1),
145
guard_tests1([], St) -> {[],St}.
147
guard_test(G0, St0) ->
149
{G1,St1} = guard_test1(G0, St0),
150
strict_record_access(G1, St1)
153
%% Normalising guard tests ensures that none of the Boolean operands
154
%% created by strict_record_access/2 calls any of the old guard tests.
155
guard_test1({call,Line,{atom,Lt,Tname},As}, St) ->
156
Test = {atom,Lt,normalise_test(Tname, length(As))},
157
expr({call,Line,Test,As}, St);
158
guard_test1(Test, St) ->
161
normalise_test(atom, 1) -> is_atom;
162
normalise_test(binary, 1) -> is_binary;
163
normalise_test(constant, 1) -> is_constant;
164
normalise_test(float, 1) -> is_float;
165
normalise_test(function, 1) -> is_function;
166
normalise_test(integer, 1) -> is_integer;
167
normalise_test(list, 1) -> is_list;
168
normalise_test(number, 1) -> is_number;
169
normalise_test(pid, 1) -> is_pid;
170
normalise_test(port, 1) -> is_port;
171
normalise_test(record, 2) -> is_record;
172
normalise_test(reference, 1) -> is_reference;
173
normalise_test(tuple, 1) -> is_tuple;
174
normalise_test(Name, _) -> Name.
177
get(erl_expand_records_in_guard) =/= undefined.
180
undefined = put(erl_expand_records_in_guard, true),
182
true = erase(erl_expand_records_in_guard),
185
%% record_test(Line, Term, Name, Vs, St) -> TransformedExpr
186
%% Generate code for is_record/1.
188
record_test(Line, Term, Name, St) ->
189
case is_in_guard() of
191
record_test_in_body(Line, Term, Name, St);
193
record_test_in_guard(Line, Term, Name, St)
196
record_test_in_guard(Line, Term, Name, St) ->
197
case not_a_tuple(Term) of
199
%% In case that later optimization passes have been turned off.
200
expr({atom,Line,false}, St);
202
Fs = record_fields(Name, St),
203
expr({call,-Line,{remote,-Line,{atom,-Line,erlang},{atom,-Line,is_record}},
204
[Term,{atom,Line,Name},{integer,Line,length(Fs)+1}]},
208
not_a_tuple({atom,_,_}) -> true;
209
not_a_tuple({integer,_,_}) -> true;
210
not_a_tuple({float,_,_}) -> true;
211
not_a_tuple({nil,_}) -> true;
212
not_a_tuple({cons,_,_,_}) -> true;
213
not_a_tuple({char,_,_}) -> true;
214
not_a_tuple({string,_,_}) -> true;
215
not_a_tuple({record_index,_,_,_}) -> true;
216
not_a_tuple({bin,_,_}) -> true;
217
not_a_tuple({op,_,_,_}) -> true;
218
not_a_tuple({op,_,_,_,_}) -> true;
219
not_a_tuple(_) -> false.
221
record_test_in_body(Line, Expr, Name, St0) ->
222
%% As Expr may have side effects, we must evaluate it
223
%% first and bind the value to a new variable.
224
%% We must use also handle the case that Expr does not
225
%% evaluate to a tuple properly.
226
Fs = record_fields(Name, St0),
227
{Var,St} = new_var(Line, St0),
229
[{match,Line,Var,Expr},
230
{call,-Line,{remote,-Line,{atom,-Line,erlang},
231
{atom,-Line,is_record}},
232
[Var,{atom,Line,Name},{integer,Line,length(Fs)+1}]}]}, St).
234
exprs([E0 | Es0], St0) ->
235
{E,St1} = expr(E0, St0),
236
{Es,St2} = exprs(Es0, St1),
238
exprs([], St) -> {[],St}.
240
expr({var,_,_}=Var, St) ->
242
expr({char,_,_}=Char, St) ->
244
expr({integer,_,_}=Int, St) ->
246
expr({float,_,_}=Float, St) ->
248
expr({atom,_,_}=Atom, St) ->
250
expr({string,_,_}=String, St) ->
252
expr({nil,_}=Nil, St) ->
254
expr({cons,Line,H0,T0}, St0) ->
255
{H,St1} = expr(H0, St0),
256
{T,St2} = expr(T0, St1),
257
{{cons,Line,H,T},St2};
258
expr({lc,Line,E0,Qs0}, St0) ->
259
{Qs1,St1} = lc_tq(Line, Qs0, St0),
260
{E1,St2} = expr(E0, St1),
261
{{lc,Line,E1,Qs1},St2};
262
expr({tuple,Line,Es0}, St0) ->
263
{Es1,St1} = expr_list(Es0, St0),
264
{{tuple,Line,Es1},St1};
265
%%expr({struct,Line,Tag,Es0}, Vs, St0) ->
266
%% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0),
267
%% {{struct,Line,Tag,Es1},Esvs,Esus,St1};
268
expr({record_field,_,_,_}=M, St) ->
269
{M,St}; % must be a package name
270
expr({record_index,Line,Name,F}, St) ->
271
I = index_expr(Line, F, Name, record_fields(Name, St)),
273
expr({record,Line,Name,Is}, St) ->
274
expr({tuple,Line,[{atom,Line,Name} |
275
record_inits(record_fields(Name, St), Is)]},
277
expr({record_field,Line,R,Name,F}, St) ->
278
get_record_field(Line, R, F, Name, St);
279
expr({record,_,R,Name,Us}, St0) ->
280
{Ue,St1} = record_update(R, Name, record_fields(Name, St0), Us, St0),
282
expr({bin,Line,Es0}, St0) ->
283
{Es1,St1} = expr_bin(Es0, St0),
284
{{bin,Line,Es1},St1};
285
expr({block,Line,Es0}, St0) ->
286
{Es,St1} = exprs(Es0, St0),
287
{{block,Line,Es},St1};
288
expr({'if',Line,Cs0}, St0) ->
289
{Cs,St1} = clauses(Cs0, St0),
290
{{'if',Line,Cs},St1};
291
expr({'case',Line,E0,Cs0}, St0) ->
292
{E,St1} = expr(E0, St0),
293
{Cs,St2} = clauses(Cs0, St1),
294
{{'case',Line,E,Cs},St2};
295
expr({'receive',Line,Cs0}, St0) ->
296
{Cs,St1} = clauses(Cs0, St0),
297
{{'receive',Line,Cs},St1};
298
expr({'receive',Line,Cs0,To0,ToEs0}, St0) ->
299
{To,St1} = expr(To0, St0),
300
{ToEs,St2} = exprs(ToEs0, St1),
301
{Cs,St3} = clauses(Cs0, St2),
302
{{'receive',Line,Cs,To,ToEs},St3};
303
expr({'fun',_,{function,_F,_A}}=Fun, St) ->
305
expr({'fun',_,{function,_M,_F,_A}}=Fun, St) ->
307
expr({'fun',Line,{clauses,Cs0}}, St0) ->
308
{Cs,St1} = clauses(Cs0, St0),
309
{{'fun',Line,{clauses,Cs}},St1};
310
expr({call,Line,{atom,_,is_record},[A,{atom,_,Name}]}, St) ->
311
record_test(Line, A, Name, St);
312
expr({'cond',Line,Cs0}, St0) ->
313
{Cs,St1} = clauses(Cs0, St0),
314
{{'cond',Line,Cs},St1};
315
expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}},
316
[A,{atom,_,Name}]}, St) ->
317
record_test(Line, A, Name, St);
318
expr({call,Line,{tuple,_,[{atom,_,erlang},{atom,_,is_record}]},
319
[A,{atom,_,Name}]}, St) ->
320
record_test(Line, A, Name, St);
321
expr({call,Line,{atom,La,N},As0}, St0) ->
322
{As,St1} = expr_list(As0, St0),
324
case erl_internal:bif(N, Ar) of
326
{{call,Line,{atom,La,N},As},St1};
328
case imported(N, Ar, St1) of
330
{{call,Line,{atom,La,N},As},St1};
334
record_info_call(Line, As, St1);
336
{{call,Line,{atom,La,N},As},St1}
340
expr({call,Line,{record_field,_,_,_}=M,As0}, St0) ->
341
{As,St1} = expr_list(As0, St0),
342
{{call,Line,M,As},St1};
343
expr({call,Line,{remote,Lr,M,F},As0}, St0) ->
344
{[M1,F1 | As1],St1} = expr_list([M,F | As0], St0),
345
{{call,Line,{remote,Lr,M1,F1},As1},St1};
346
expr({call,Line,{tuple,Lt,[{atom,_,_}=M,{atom,_,_}=F]},As0}, St0) ->
347
{As,St1} = expr_list(As0, St0),
348
{{call,Line,{tuple,Lt,[M,F]},As},St1};
349
expr({call,Line,F,As0}, St0) ->
350
{[Fun1 | As1],St1} = expr_list([F | As0], St0),
351
{{call,Line,Fun1,As1},St1};
352
expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) ->
353
{Es1,St1} = exprs(Es0, St0),
354
{Scs1,St2} = clauses(Scs0, St1),
355
{Ccs1,St3} = clauses(Ccs0, St2),
356
{As1,St4} = exprs(As0, St3),
357
{{'try',Line,Es1,Scs1,Ccs1,As1},St4};
358
expr({'catch',Line,E0}, St0) ->
359
{E,St1} = expr(E0, St0),
360
{{'catch',Line,E},St1};
361
expr({match,Line,P0,E0}, St0) ->
362
{E,St1} = expr(E0, St0),
363
{P,St2} = pattern(P0, St1),
364
{{match,Line,P,E},St2};
365
expr({op,Line,'not',A0}, St0) ->
366
{A,St1} = bool_operand(A0, St0),
367
{{op,Line,'not',A},St1};
368
expr({op,Line,Op,A0}, St0) ->
369
{A,St1} = expr(A0, St0),
370
{{op,Line,Op,A},St1};
371
expr({op,Line,Op,L0,R0}, St0) when Op =:= 'and';
373
{L,St1} = bool_operand(L0, St0),
374
{R,St2} = bool_operand(R0, St1),
375
{{op,Line,Op,L,R},St2};
376
expr({op,Line,Op,L0,R0}, St0) when Op =:= 'andalso';
378
{L,St1} = bool_operand(L0, St0),
379
{R,St2} = bool_operand(R0, St1),
380
{{op,Line,Op,L,R},St2#exprec{checked_ra = St1#exprec.checked_ra}};
381
expr({op,Line,Op,L0,R0}, St0) ->
382
{L,St1} = expr(L0, St0),
383
{R,St2} = expr(R0, St1),
384
{{op,Line,Op,L,R},St2}.
386
expr_list([E0 | Es0], St0) ->
387
{E,St1} = expr(E0, St0),
388
{Es,St2} = expr_list(Es0, St1),
390
expr_list([], St) -> {[],St}.
392
bool_operand(E0, St0) ->
393
{E1,St1} = expr(E0, St0),
394
strict_record_access(E1, St1).
396
strict_record_access(E, #exprec{strict_ra = []} = St) ->
398
strict_record_access(E0, St0) ->
399
#exprec{strict_ra = StrictRA, checked_ra = CheckedRA} = St0,
400
{New,NC} = lists:foldl(fun ({Key,_L,_R,_Sz}=A, {L,C}) ->
401
case lists:keymember(Key, 1, C) of
403
false -> {[A|L],[A|C]}
405
end, {[],CheckedRA}, StrictRA),
406
E1 = if New =:= [] -> E0; true -> conj(New, E0) end,
407
St1 = St0#exprec{strict_ra = [], checked_ra = NC},
410
%% Make it look nice (?) when compiled with the 'E' flag
411
%% ('and'/2 is left recursive).
414
conj([{{Name,_Rp},L,R,Sz} | AL], E) ->
416
{call,L,{atom,L,is_record},[R,{atom,L,Name},{integer,L,Sz}]},
418
T2 = case conj(AL, none) of
420
C -> {op,L,'and',C,T1}
422
if E =:= none -> T2; true -> {op,L,'and',T2,E} end.
424
%% lc_tq(Line, Qualifiers, State) ->
425
%% {[TransQual],State'}
427
lc_tq(Line, [{generate,Lg,P0,G0} | Qs0], St0) ->
428
{G1,St1} = expr(G0, St0),
429
{P1,St2} = pattern(P0, St1),
430
{Qs1,St3} = lc_tq(Line, Qs0, St2),
431
{[{generate,Lg,P1,G1} | Qs1],St3};
432
lc_tq(Line, [F0 | Qs0], St0) ->
433
%% Allow record/2 and expand out as guard test.
434
case erl_lint:is_guard_test(F0) of
436
{F1,St1} = guard_test(F0, St0),
437
{Qs1,St2} = lc_tq(Line, Qs0, St1),
440
{F1,St1} = expr(F0, St0),
441
{Qs1,St2} = lc_tq(Line, Qs0, St1),
444
lc_tq(_Line, [], St0) ->
445
{[],St0#exprec{checked_ra = []}}.
447
%% normalise_fields([RecDef]) -> [Field].
448
%% Normalise the field definitions to always have a default value. If
449
%% none has been given then use 'undefined'.
451
normalise_fields(Fs) ->
452
map(fun ({record_field,Lf,Field}) ->
453
{record_field,Lf,Field,{atom,Lf,undefined}};
456
%% record_fields(RecordName, State)
457
%% find_field(FieldName, Fields)
459
record_fields(R, St) -> dict:fetch(R, St#exprec.records).
461
find_field(F, [{record_field,_,{atom,_,F},Val} | _]) -> {ok,Val};
462
find_field(F, [_ | Fs]) -> find_field(F, Fs);
463
find_field(_, []) -> error.
465
%% field_names(RecFields) -> [Name].
466
%% Return a list of the field names structures.
469
map(fun ({record_field,_,Field,_Val}) -> Field end, Fs).
471
%% index_expr(Line, FieldExpr, Name, Fields) -> IndexExpr.
472
%% Return an expression which evaluates to the index of a
473
%% field. Currently only handle the case where the field is an
474
%% atom. This expansion must be passed through expr again.
476
index_expr(Line, {atom,_,F}, _Name, Fs) ->
477
{integer,Line,index_expr(F, Fs, 2)}.
479
index_expr(F, [{record_field,_,{atom,_,F},_} | _], I) -> I;
480
index_expr(F, [_ | Fs], I) -> index_expr(F, Fs, I+1).
482
%% get_record_field(Line, RecExpr, FieldExpr, Name, St) -> {Expr,St'}.
483
%% Return an expression which verifies that the type of record
484
%% is correct and then returns the value of the field.
485
%% This expansion must be passed through expr again.
487
get_record_field(Line, R, Index, Name, St) ->
488
case strict_record_tests(St#exprec.compile) of
490
sloppy_get_record_field(Line, R, Index, Name, St);
492
strict_get_record_field(Line, R, Index, Name, St)
495
strict_get_record_field(Line, R, {atom,_,F}=Index, Name, St0) ->
496
case is_in_guard() of
497
false -> %Body context.
498
{Var,St} = new_var(Line, St0),
499
Fs = record_fields(Name, St),
500
I = index_expr(F, Fs, 2),
501
P = record_pattern(2, I, Var, length(Fs)+1, Line, [{atom,Line,Name}]),
503
[{clause,Line,[{tuple,Line,P}],[],[Var]},
504
{clause,Line,[{var,Line,'_'}],[],
505
[{call,Line,{remote,Line,
508
[{tuple,Line,[{atom,Line,badrecord},{atom,Line,Name}]}]}]}]},
511
Fs = record_fields(Name, St0),
512
I = index_expr(Line, Index, Name, Fs),
513
{ExpR,St1} = expr(R, St0),
514
%% Just to make comparison simple:
515
ExpRp = erl_lint:modify_line(ExpR, fun(_L) -> 0 end),
516
RA = {{Name,ExpRp},Line,ExpR,length(Fs)+1},
517
St2 = St1#exprec{strict_ra = [RA | St1#exprec.strict_ra]},
518
{{call,Line,{atom,Line,element},[I,ExpR]},St2}
521
record_pattern(I, I, Var, Sz, Line, Acc) ->
522
record_pattern(I+1, I, Var, Sz, Line, [Var | Acc]);
523
record_pattern(Cur, I, Var, Sz, Line, Acc) when Cur =< Sz ->
524
record_pattern(Cur+1, I, Var, Sz, Line, [{var,Line,'_'} | Acc]);
525
record_pattern(_, _, _, _, _, Acc) -> reverse(Acc).
527
sloppy_get_record_field(Line, R, Index, Name, St) ->
528
Fs = record_fields(Name, St),
529
I = index_expr(Line, Index, Name, Fs),
530
expr({call,Line,{atom,Line,element},[I,R]}, St).
532
strict_record_tests([strict_record_tests | _]) -> true;
533
strict_record_tests([no_strict_record_tests | _]) -> false;
534
strict_record_tests([_ | Os]) -> strict_record_tests(Os);
535
strict_record_tests([]) -> true. %Default.
537
%% pattern_fields([RecDefField], [Match]) -> [Pattern].
538
%% Build a list of match patterns for the record tuple elements.
539
%% This expansion must be passed through pattern again. N.B. We are
540
%% scanning the record definition field list!
542
pattern_fields(Fs, Ms) ->
543
Wildcard = record_wildcard_init(Ms),
544
map(fun ({record_field,L,{atom,_,F},_}) ->
545
case find_field(F, Ms) of
547
error when Wildcard =:= none -> {var,L,'_'};
552
%% record_inits([RecDefField], [Init]) -> [InitExpr].
553
%% Build a list of initialisation expressions for the record tuple
554
%% elements. This expansion must be passed through expr
555
%% again. N.B. We are scanning the record definition field list!
557
record_inits(Fs, Is) ->
558
WildcardInit = record_wildcard_init(Is),
559
map(fun ({record_field,_,{atom,_,F},D}) ->
560
case find_field(F, Is) of
562
error when WildcardInit =:= none -> D;
563
error -> WildcardInit
567
record_wildcard_init([{record_field,_,{var,_,'_'},D} | _]) -> D;
568
record_wildcard_init([_ | Is]) -> record_wildcard_init(Is);
569
record_wildcard_init([]) -> none.
571
%% record_update(Record, RecordName, [RecDefField], [Update], State) ->
573
%% Build an expression to update fields in a record returning a new
574
%% record. Try to be smart and optimise this. This expansion must be
575
%% passed through expr again.
577
record_update(R, Name, Fs, Us0, St0) ->
578
Line = element(2, R),
579
{Pre,Us,St1} = record_exprs(Us0, St0),
580
Nf = length(Fs), %# of record fields
581
Nu = length(Us), %# of update fields
582
Nc = Nf - Nu, %# of copy fields
584
%% We need a new variable for the record expression
585
%% to guarantee that it is only evaluated once.
586
{Var,St2} = new_var(Line, St1),
588
%% Try to be intelligent about which method of updating record to use.
591
Nu == 0 -> {R,St2}; %No fields updated
592
Nu =< Nc -> %Few fields updated
593
{record_setel(Var, Name, Fs, Us), St2};
594
true -> %The wide area inbetween
595
record_match(Var, Name, Fs, Us, St2)
597
{{block,element(2, R),Pre ++ [{match,Line,Var,R},Update]},St}.
599
%% record_match(Record, RecordName, [RecDefField], [Update], State)
600
%% Build a 'case' expression to modify record fields.
602
record_match(R, Name, Fs, Us, St0) ->
603
{Ps,News,St1} = record_upd_fs(Fs, Us, St0),
604
Lr = element(2, hd(Us)),
606
[{clause,Lr,[{tuple,Lr,[{atom,Lr,Name} | Ps]}],[],
607
[{tuple,Lr,[{atom,Lr,Name} | News]}]},
608
{clause,Lr,[{var,Lr,'_'}],[],
609
[call_error(Lr, {tuple,Lr,[{atom,Lr,badrecord},{atom,Lr,Name}]})]}
613
record_upd_fs([{record_field,Lf,{atom,_La,F},_Val} | Fs], Us, St0) ->
614
{P,St1} = new_var(Lf, St0),
615
{Ps,News,St2} = record_upd_fs(Fs, Us, St1),
616
case find_field(F, Us) of
617
{ok,New} -> {[P | Ps],[New | News],St2};
618
error -> {[P | Ps],[P | News],St2}
620
record_upd_fs([], _, St) -> {[],[],St}.
622
%% record_setel(Record, RecordName, [RecDefField], [Update])
623
%% Build a nested chain of setelement calls to build the
624
%% updated record tuple.
626
record_setel(R, Name, Fs, Us0) ->
627
Us1 = foldl(fun ({record_field,Lf,Field,Val}, Acc) ->
628
I = index_expr(Lf, Field, Name, Fs),
632
Lr = element(2, hd(Us)),
633
Wildcards = duplicate(length(Fs), {var,Lr,'_'}),
635
[{clause,Lr,[{tuple,Lr,[{atom,Lr,Name} | Wildcards]}],[],
636
[foldr(fun ({I,Lf,Val}, Acc) ->
637
{call,Lf,{atom,Lf,setelement},[I,Acc,Val]} end,
639
{clause,Lr,[{var,Lr,'_'}],[],
640
[call_error(Lr, {tuple,Lr,[{atom,Lr,badrecord},{atom,Lr,Name}]})]}]}.
642
%% Expand a call to record_info/2. We have checked that it is not
643
%% shadowed by an import.
645
record_info_call(Line, [{atom,_Li,Info},{atom,_Ln,Name}], St) ->
648
{{integer,Line,1+length(record_fields(Name, St))},St};
650
{make_list(field_names(record_fields(Name, St)), Line),St}
653
%% Break out expressions from an record update list and bind to new
654
%% variables. The idea is that we will evaluate all update expressions
655
%% before starting to update the record.
657
record_exprs(Us, St) ->
658
record_exprs(Us, St, [], []).
660
record_exprs([{record_field,Lf,{atom,_La,_F}=Name,Val}=Field0 | Us], St0, Pre, Fs) ->
661
case is_simple_val(Val) of
663
record_exprs(Us, St0, Pre, [Field0 | Fs]);
665
{Var,St} = new_var(Lf, St0),
666
Bind = {match,Lf,Var,Val},
667
Field = {record_field,Lf,Name,Var},
668
record_exprs(Us, St, [Bind | Pre], [Field | Fs])
670
record_exprs([], St, Pre, Fs) ->
671
{reverse(Pre),Fs,St}.
673
is_simple_val({var,_,_}) -> true;
674
is_simple_val(Val) ->
676
erl_parse:normalise(Val),
682
%% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}.
684
pattern_bin(Es0, St) ->
685
foldr(fun (E, Acc) -> pattern_element(E, Acc) end, {[],St}, Es0).
687
pattern_element({bin_element,Line,Expr0,Size,Type}, {Es,St0}) ->
688
{Expr,St1} = pattern(Expr0, St0),
689
{[{bin_element,Line,Expr,Size,Type} | Es],St1}.
691
%% expr_bin([Element], State) -> {[Element],State}.
694
foldr(fun (E, Acc) -> bin_element(E, Acc) end, {[],St}, Es0).
696
bin_element({bin_element,Line,Expr,Size,Type}, {Es,St0}) ->
697
{Expr1,St1} = expr(Expr, St0),
698
{Size1,St2} = if Size == default -> {default,St1};
699
true -> expr(Size, St1)
701
{[{bin_element,Line,Expr1,Size1,Type} | Es],St2}.
704
{New,St1} = new_var_name(St0),
708
C = St#exprec.vcount,
709
{list_to_atom("rec" ++ integer_to_list(C)),St#exprec{vcount=C+1}}.
711
make_list(Ts, Line) ->
712
foldr(fun (H, T) -> {cons,Line,H,T} end, {nil,Line}, Ts).
715
{call,L,{remote,L,{atom,L,erlang},{atom,L,error}},[R]}.
717
import({Mod,Fs}, St) ->
718
St#exprec{imports=add_imports(Mod, Fs, St#exprec.imports)};
722
add_imports(Mod, [F | Fs], Is) ->
723
add_imports(Mod, Fs, orddict:store(F, Mod, Is));
724
add_imports(_, [], Is) -> Is.
726
imported(F, A, St) ->
727
case orddict:find({F,A}, St#exprec.imports) of
728
{ok,Mod} -> {yes,Mod};
added
removed
lib/stdlib/src/erl_expand_records.erl
