← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lib/diameter/src/compiler/diameter_exprecs.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/diameter/src/compiler/diameter_exprecs.erl
 
1
%%
 
2
%% %CopyrightBegin%
 
3
%%
 
4
%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
 
5
%%
 
6
%% The contents of this file are subject to the Erlang Public License,
 
7
%% Version 1.1, (the "License"); you may not use this file except in
 
8
%% compliance with the License. You should have received a copy of the
 
9
%% Erlang Public License along with this software. If not, it can be
 
10
%% retrieved online at http://www.erlang.org/.
 
11
%%
 
12
%% Software distributed under the License is distributed on an "AS IS"
 
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
14
%% the License for the specific language governing rights and limitations
 
15
%% under the License.
 
16
%%
 
17
%% %CopyrightEnd%
 
18
%%
 
19
 
 
20
%%
 
21
%% Parse transform for generating record access functions
 
22
%%
 
23
%% This parse transform can be used to reduce compile-time
 
24
%% dependencies in large systems.
 
25
%%
 
26
%% In the old days, before records, Erlang programmers often wrote
 
27
%% access functions for tuple data. This was tedious and error-prone.
 
28
%% The record syntax made this easier, but since records were implemented
 
29
%% fully in the pre-processor, a nasty compile-time dependency was
 
30
%% introduced.
 
31
%%
 
32
%% This module automates the generation of access functions for
 
33
%% records. While this method cannot fully replace the utility of
 
34
%% pattern matching, it does allow a fair bit of functionality on
 
35
%% records without the need for compile-time dependencies.
 
36
%%
 
37
%% Whenever record definitions need to be exported from a module,
 
38
%% inserting a compiler attribute,
 
39
%%
 
40
%%   export_records([RecName, ...])
 
41
%%
 
42
%% causes this transform to lay out access functions for the exported
 
43
%% records:
 
44
%%
 
45
%%   -module(foo)
 
46
%%   -compile({parse_transform, diameter_exprecs}).
 
47
%%
 
48
%%   -record(r, {a, b, c}).
 
49
%%   -export_records([a]).
 
50
%%
 
51
%%   -export(['#info-'/1, '#info-'/2,
 
52
%%            '#new-'/1, '#new-'/2,
 
53
%%            '#get-'/2, '#set-'/2,
 
54
%%            '#new-a'/0, '#new-a'/1,
 
55
%%            '#get-a'/2, '#set-a'/2,
 
56
%%            '#info-a'/1]).
 
57
%%
 
58
%%   '#info-'(RecName) ->
 
59
%%       '#info-'(RecName, fields).
 
60
%%
 
61
%%   '#info-'(r, Info) ->
 
62
%%       '#info-r'(Info).
 
63
%%
 
64
%%   '#new-'(r) -> #r{}.
 
65
%%   '#new-'(r, Vals) -> '#new-r'(Vals)
 
66
%%
 
67
%%   '#new-r'() -> #r{}.
 
68
%%   '#new-r'(Vals) -> '#set-r'(Vals, #r{}).
 
69
%%
 
70
%%   '#get-'(Attrs, #r{} = Rec) ->
 
71
%%       '#get-r'(Attrs, Rec).
 
72
%%
 
73
%%   '#get-r'(Attrs, Rec) when is_list(Attrs) ->
 
74
%%       ['#get-r'(A, Rec) || A <- Attrs];
 
75
%%   '#get-r'(a, Rec) -> Rec#r.a;
 
76
%%   '#get-r'(b, Rec) -> Rec#r.b;
 
77
%%   '#get-r'(c, Rec) -> Rec#r.c.
 
78
%%
 
79
%%   '#set-'(Vals, #r{} = Rec) ->
 
80
%%       '#set-r'(Vals, Rec).
 
81
%%
 
82
%%   '#set-r'(Vals, Rec) when is_list(Vals) ->
 
83
%%       lists:foldl(fun '#set-r'/2, Rec, Vals);
 
84
%%   '#set-r'({a,V}, Rec) -> Rec#r{a = V};
 
85
%%   '#set-r'({b,V}, Rec) -> Rec#r{b = V};
 
86
%%   '#set-r'({c,V}, Rec) -> Rec#r{c = V}.
 
87
%%
 
88
%%   '#info-r'(fields) -> record_info(fields, r);
 
89
%%   '#info-r'(size) -> record_info(size, r);
 
90
%%   '#info-r'({index, a}) -> 1;
 
91
%%   '#info-r'({index, b}) -> 2;
 
92
%%   '#info-r'({index, c}) -> 3;
 
93
%%
 
94
 
 
95
-module(diameter_exprecs).
 
96
 
 
97
-export([parse_transform/2]).
 
98
 
 
99
-include("diameter_forms.hrl").
 
100
 
 
101
%% parse_transform/2
 
102
 
 
103
parse_transform(Forms, _Options) ->
 
104
    Rs = [R || {attribute, _, record, R} <- Forms],
 
105
    Es = lists:append([E || {attribute, _, export_records, E} <- Forms]),
 
106
    {H,T} = lists:splitwith(fun is_head/1, Forms),
 
107
    H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T.
 
108
 
 
109
is_head(T) ->
 
110
    not lists:member(element(1,T), [function, eof]).
 
111
 
 
112
%% a_export/1
 
113
 
 
114
a_export(Exports) ->
 
115
    {?attribute, export, [{fname(info), 1},
 
116
                          {fname(info), 2},
 
117
                          {fname(new), 1},
 
118
                          {fname(new), 2},
 
119
                          {fname(get), 2},
 
120
                          {fname(set), 2}
 
121
                          | lists:flatmap(fun export/1, Exports)]}.
 
122
 
 
123
export(Rname) ->
 
124
    New = fname(new, Rname),
 
125
    [{New, 0},
 
126
     {New, 1},
 
127
     {fname(get, Rname), 2},
 
128
     {fname(set, Rname), 2},
 
129
     {fname(info, Rname), 1}].
 
130
 
 
131
%% f_accessors/2
 
132
 
 
133
f_accessors(Es, Rs) ->
 
134
    ['#info-/1'(),
 
135
     '#info-/2'(Es),
 
136
     '#new-/1'(Es),
 
137
     '#new-/2'(Es),
 
138
     '#get-/2'(Es),
 
139
     '#set-/2'(Es)
 
140
     | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)].
 
141
 
 
142
accessors(Rname, Fields) ->
 
143
    ['#new-X/0'(Rname),
 
144
     '#new-X/1'(Rname),
 
145
     '#get-X/2'(Rname, Fields),
 
146
     '#set-X/2'(Rname, Fields),
 
147
     '#info-X/1'(Rname, Fields)].
 
148
 
 
149
fields(Rname, Recs) ->
 
150
    {Rname, Fields} = lists:keyfind(Rname, 1, Recs),
 
151
    lists:map(fun({record_field, _, {atom, _, N}})    -> N;
 
152
                 ({record_field, _, {atom, _, N}, _}) -> N
 
153
              end,
 
154
              Fields).
 
155
 
 
156
fname_prefix(Op) ->
 
157
    "#" ++ atom_to_list(Op) ++ "-".
 
158
 
 
159
fname(Op) ->
 
160
    list_to_atom(fname_prefix(Op)).
 
161
 
 
162
fname(Op, Rname) ->
 
163
    Prefix = fname_prefix(Op),
 
164
    list_to_atom(Prefix ++ atom_to_list(Rname)).
 
165
 
 
166
%% Generated functions.
 
167
 
 
168
'#info-/1'() ->
 
169
    Fname = fname(info),
 
170
    {?function, Fname, 1,
 
171
     [{?clause, [?VAR('RecName')],
 
172
       [],
 
173
       [?CALL(Fname, [?VAR('RecName'), ?ATOM(fields)])]}]}.
 
174
 
 
175
'#info-/2'(Exports) ->
 
176
    {?function, fname(info), 2,
 
177
     lists:map(fun 'info-'/1, Exports) ++ [?BADARG(2)]}.
 
178
 
 
179
'info-'(R) ->
 
180
    {?clause, [?ATOM(R), ?VAR('Info')],
 
181
     [],
 
182
     [?CALL(fname(info, R), [?VAR('Info')])]}.
 
183
 
 
184
'#new-/1'(Exports) ->
 
185
    {?function, fname(new), 1,
 
186
     lists:map(fun 'new-'/1, Exports) ++ [?BADARG(1)]}.
 
187
 
 
188
'new-'(R) ->
 
189
    {?clause, [?ATOM(R)],
 
190
     [],
 
191
     [{?record, R, []}]}.
 
192
 
 
193
'#new-/2'(Exports) ->
 
194
    {?function, fname(new), 2,
 
195
     lists:map(fun 'new--'/1, Exports) ++ [?BADARG(2)]}.
 
196
 
 
197
'new--'(R) ->
 
198
    {?clause, [?ATOM(R), ?VAR('Vals')],
 
199
     [],
 
200
     [?CALL(fname(new, R), [?VAR('Vals')])]}.
 
201
 
 
202
'#get-/2'(Exports) ->
 
203
    {?function, fname(get), 2,
 
204
     lists:map(fun 'get-'/1, Exports) ++ [?BADARG(2)]}.
 
205
 
 
206
'get-'(R) ->
 
207
    {?clause, [?VAR('Attrs'),
 
208
               {?match, {?record, R, []}, ?VAR('Rec')}],
 
209
     [],
 
210
     [?CALL(fname(get, R), [?VAR('Attrs'), ?VAR('Rec')])]}.
 
211
 
 
212
'#set-/2'(Exports) ->
 
213
    {?function, fname(set), 2,
 
214
     lists:map(fun 'set-'/1, Exports) ++ [?BADARG(2)]}.
 
215
 
 
216
'set-'(R) ->
 
217
    {?clause, [?VAR('Vals'), {?match, {?record, R, []}, ?VAR('Rec')}],
 
218
     [],
 
219
     [?CALL(fname(set, R), [?VAR('Vals'), ?VAR('Rec')])]}.
 
220
 
 
221
'#new-X/0'(Rname) ->
 
222
    {?function, fname(new, Rname), 0,
 
223
     [{?clause, [],
 
224
       [],
 
225
       [{?record, Rname, []}]}]}.
 
226
 
 
227
'#new-X/1'(Rname) ->
 
228
    {?function, fname(new, Rname), 1,
 
229
     [{?clause, [?VAR('Vals')],
 
230
       [],
 
231
       [?CALL(fname(set, Rname), [?VAR('Vals'), {?record, Rname, []}])]}]}.
 
232
 
 
233
'#set-X/2'(Rname, Fields) ->
 
234
    {?function, fname(set, Rname), 2,
 
235
     [{?clause, [?VAR('Vals'), ?VAR('Rec')],
 
236
       [[?CALL(is_list, [?VAR('Vals')])]],
 
237
       [?APPLY(lists, foldl, [{?'fun', {function, fname(set, Rname), 2}},
 
238
                              ?VAR('Rec'),
 
239
                              ?VAR('Vals')])]}
 
240
      | lists:map(fun(A) -> 'set-X'(Rname, A) end, Fields)]}.
 
241
 
 
242
'set-X'(Rname, Attr) ->
 
243
    {?clause, [{?tuple, [?ATOM(Attr), ?VAR('V')]}, ?VAR('Rec')],
 
244
     [],
 
245
     [{?record, ?VAR('Rec'), Rname,
 
246
       [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}.
 
247
 
 
248
'#get-X/2'(Rname, Fields) ->
 
249
    FName = fname(get, Rname),
 
250
    {?function, FName, 2,
 
251
     [{?clause, [?VAR('Attrs'), ?VAR('Rec')],
 
252
       [[?CALL(is_list, [?VAR('Attrs')])]],
 
253
       [{?lc, ?CALL(FName, [?VAR('A'), ?VAR('Rec')]),
 
254
         [{?generate, ?VAR('A'), ?VAR('Attrs')}]}]}
 
255
      | lists:map(fun(A) -> 'get-X'(Rname, A) end, Fields)]}.
 
256
 
 
257
'get-X'(Rname, Attr) ->
 
258
    {?clause, [?ATOM(Attr), ?VAR('Rec')],
 
259
     [],
 
260
     [{?record_field, ?VAR('Rec'), Rname, ?ATOM(Attr)}]}.
 
261
 
 
262
'#info-X/1'(Rname, Fields) ->
 
263
    {?function, fname(info, Rname), 1,
 
264
     [{?clause, [?ATOM(fields)],
 
265
       [],
 
266
       [?CALL(record_info, [?ATOM(fields), ?ATOM(Rname)])]},
 
267
      {?clause, [?ATOM(size)],
 
268
       [],
 
269
       [?CALL(record_info, [?ATOM(size), ?ATOM(Rname)])]}
 
270
      | lists:map(fun(A) -> 'info-X'(Rname, A) end, Fields)]}.
 
271
 
 
272
'info-X'(Rname, Attr) ->
 
273
    {?clause, [{?tuple, [?ATOM(index), ?ATOM(Attr)]}],
 
274
     [],
 
275
     [{?record_index, Rname, ?ATOM(Attr)}]}.