Harald Welte | 674a425 | 2011-04-02 16:44:52 +0200 | [diff] [blame] | 1 | %%% The contents of this file are subject to the Erlang Public License, |
| 2 | %%% Version 1.0, (the "License"); you may not use this file except in |
| 3 | %%% compliance with the License. You may obtain a copy of the License at |
| 4 | %%% http://www.erlang.org/license/EPL1_0.txt |
| 5 | %%% |
| 6 | %%% Software distributed under the License is distributed on an "AS IS" |
| 7 | %%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See |
| 8 | %%% the License for the specific language governing rights and limitations |
| 9 | %%% under the License. |
| 10 | %%% |
| 11 | %%% The Original Code is exprecs-0.2. |
| 12 | %%% |
| 13 | %%% The Initial Developer of the Original Code is Ericsson AB. |
| 14 | %%% Portions created by Ericsson are Copyright (C), 2006, Ericsson AB. |
| 15 | %%% All Rights Reserved. |
| 16 | %%% |
| 17 | %%% Contributor(s): ______________________________________. |
| 18 | |
| 19 | %%%------------------------------------------------------------------- |
| 20 | %%% File : exprecs.erl |
| 21 | %%% @author : Ulf Wiger <ulf.wiger@ericsson.com> |
| 22 | %%% @end |
| 23 | %%% Description : |
| 24 | %%% |
| 25 | %%% Created : 13 Feb 2006 by Ulf Wiger <ulf.wiger@ericsson.com> |
| 26 | %%%------------------------------------------------------------------- |
| 27 | |
| 28 | %%% @doc Parse transform for generating record access functions |
| 29 | %%% <p>This parse transform can be used to reduce compile-time |
| 30 | %%% dependencies in large systems.</p> |
| 31 | %%% <p>In the old days, before records, Erlang programmers often wrote |
| 32 | %%% access functions for tuple data. This was tedious and error-prone. |
| 33 | %%% The record syntax made this easier, but since records were implemented |
| 34 | %%% fully in the pre-processor, a nasty compile-time dependency was |
| 35 | %%% introduced.</p> |
| 36 | %%% <p>This module automates the generation of access functions for |
| 37 | %%% records. While this method cannot fully replace the utility of |
| 38 | %%% pattern matching, it does allow a fair bit of functionality on |
| 39 | %%% records without the need for compile-time dependencies.</p> |
| 40 | %%% <p>Whenever record definitions need to be exported from a module, |
| 41 | %%% inserting a compiler attribute, |
| 42 | %%% <code>export_records([RecName|...])</code> causes this transform |
| 43 | %%% to lay out access functions for the exported records:</p> |
| 44 | %%% |
| 45 | %%% <pre> |
| 46 | %%% -record(a, {a, b, c}). |
| 47 | %%% -export_records([a]). |
| 48 | %%% -export(['#info-'/2, |
| 49 | %%% '#get-'/2, '#set-'/2, |
| 50 | %%% '#new-a'/0, '#new-a'/1, |
| 51 | %%% '#get-a'/2, '#set-a'/2, |
| 52 | %%% '#info-a'/1]). |
| 53 | %%% |
| 54 | %%% '#info-'(Info, Rec) when is_record(Rec, a) -> |
| 55 | %%% '#info-a'(Info). |
| 56 | %%% |
| 57 | %%% '#get-'(Attrs, Rec) when is_record(Rec, a) -> |
| 58 | %%% '#get-a'(Attrs, Rec). |
| 59 | %%% |
| 60 | %%% '#set-'(Attrs, Rec) when is_record(Rec, a) -> |
| 61 | %%% '#set-a'(Attrs, Rec). |
| 62 | %%% |
| 63 | %%% '#new-a'() -> #a{}. |
| 64 | %%% '#new-a'(Vals) -> '#set-a'(Vals, #a{}). |
| 65 | %%% |
| 66 | %%% '#get-a'(Attrs, R) when is_list(Attrs) -> |
| 67 | %%% ['#get-a'(A, R) || A <- Attrs]; |
| 68 | %%% '#get-a'(a, R) -> R#a.a; |
| 69 | %%% '#get-a'(b, R) -> R#a.b; |
| 70 | %%% '#get-a'(c, R) -> R#a.c. |
| 71 | %%% |
| 72 | %%% '#set-a'(Vals, Rec) -> |
| 73 | %%% F = fun ([], R, _F1) -> R; |
| 74 | %%% ([{a, V} | T], R, F1) -> F1(T, R#a{a = V}, F1); |
| 75 | %%% ([{b, V} | T], R, F1) -> F1(T, R#a{b = V}, F1); |
| 76 | %%% ([{c, V} | T], R, F1) -> F1(T, R#a{c = V}, F1) |
| 77 | %%% end, |
| 78 | %%% F(Vals, Rec, F). |
| 79 | %%% |
| 80 | %%% '#info-a'(size) -> record_info(size, a); |
| 81 | %%% '#info-a'(fields) -> record_info(fields, a). |
| 82 | %%% </pre> |
| 83 | %%% <p>The generated accessor functions are:</p> |
| 84 | %%% <table border="1"> |
| 85 | %%% <tr><td><code>'#new-R'() -> #R{}</code></td> |
| 86 | %%% <td>Instantiates a new record of type `R'.</td></tr> |
| 87 | %%% <tr><td><code>'#new-R'(Data) -> #R{}</code></td> |
| 88 | %%% <td>Exactly equivalent to calling |
| 89 | %%% <code>'#set-R'(Data,'#new-R'())</code></td></tr> |
| 90 | %%% <tr><td><code>'#info-R'(Info) -><br/> |
| 91 | %%%   [FldName]<br/> |
| 92 | %%% Info :: fields | size</code></td> |
| 93 | %%% <td>Equivalent to `record_info(fields, R)' for the |
| 94 | %%% given record type R.</td></tr> |
| 95 | %%% <tr><td><code>'#info-'(Info, Rec) -><br/> |
| 96 | %%%   [FldName]</code></td> |
| 97 | %%% <td>Detects the record type of `Rec', and calls the corresponding |
| 98 | %%% <code>'#info-R'/1</code> function.</td></tr> |
| 99 | %%% <tr><td><code>'#get-R'(A, Rec) -><br/> |
| 100 | %%%   Value | [Value]</code></td> |
| 101 | %%% <td>Returns the value (if `A' is an atom) of the given field, |
| 102 | %%% in `Rec' (which must be a record of type `R'), |
| 103 | %%% or a list of values (if `A' is a list of atoms).</td></tr> |
| 104 | %%% <tr><td><code>'#get-'(A, Rec) -><br/> |
| 105 | %%%   Value | [Value]</code></td> |
| 106 | %%% <td>Detects the record type of `Rec' and calls the corresponding |
| 107 | %%% <code>'#get-R'(A, Rec)</code> function.</td></tr> |
| 108 | %%% <tr><td><code>'#set-R'(Data, Rec) -><br/> |
| 109 | %%%   Data | [{Attr::atom(), Value}]</code></td> |
| 110 | %%% <td>Takes a list of `{Attr,Value}' tuples and sets the corresponding |
| 111 | %%% attributes in the record `Rec' (which must be of type `R'). |
| 112 | %%% Each `Attr' in the list must correspond to an actual attribute |
| 113 | %%% in the record `R'.</td></tr> |
| 114 | %%% <tr><td><code>'#set-'(Data, Rec) -><br/> |
| 115 | %%%   Value | [Value]</code></td> |
| 116 | %%% <td>Detects the record type of `Rec' and calls the corresponding |
| 117 | %%% <code>'#set-R'(Data, Rec)</code> function.</td></tr> |
| 118 | %%% </table> |
| 119 | %%% @end |
| 120 | |
| 121 | -module(exprecs). |
| 122 | |
| 123 | -export([parse_transform/2, |
| 124 | format_error/1, |
| 125 | transform/3, |
| 126 | context/2]). |
| 127 | |
| 128 | -record(context, {module, |
| 129 | function, |
| 130 | arity}). |
| 131 | |
| 132 | -record(pass1, {exports = [], |
| 133 | generated = false, |
| 134 | records = []}). |
| 135 | |
| 136 | -define(HERE, {?MODULE, ?LINE}). |
| 137 | |
| 138 | -define(ERROR(R, F, I), |
| 139 | begin |
| 140 | rpt_error(R, F, I), |
| 141 | |
| 142 | throw({error,get_pos(I),{unknown,R}}) |
| 143 | end). |
| 144 | |
| 145 | get_pos(I) -> |
| 146 | case proplists:get_value(form, I) of |
| 147 | undefined -> |
| 148 | 0; |
| 149 | Form -> |
| 150 | erl_syntax:get_pos(Form) |
| 151 | end. |
| 152 | |
| 153 | parse_transform(Forms, Options) -> |
| 154 | [File|_] = [F || {attribute,_,file,{F,_}} <- Forms], |
| 155 | try do_transform(Forms, Options) of |
| 156 | Res -> |
| 157 | %% io:format("Res = ~p~n", [Res]), |
| 158 | Res |
| 159 | catch |
| 160 | throw:{error, Ln, What} -> |
| 161 | {error, [{File, [{Ln, ?MODULE, What}]}], []} |
| 162 | end. |
| 163 | |
| 164 | do_transform(Forms, _Options) -> |
| 165 | %% |
| 166 | %% 1st pass - collect record info |
| 167 | %% |
| 168 | Fun1 = |
| 169 | fun(attribute, {attribute,_L,record,RecDef}=Form, _Ctxt, Acc) -> |
| 170 | Recs0 = Acc#pass1.records, |
| 171 | {Form, false, Acc#pass1{records = [RecDef|Recs0]}}; |
| 172 | (attribute, {attribute,_L,export_records, E}=Form, _Ctxt, Acc) -> |
| 173 | Exports0 = Acc#pass1.exports, |
| 174 | NewExports = Exports0 ++ E, |
| 175 | {Form, false, Acc#pass1{exports = NewExports}}; |
| 176 | (_Type, Form, _Context, Acc) -> |
| 177 | {Form, false, Acc} |
| 178 | end, |
| 179 | {Forms1, Acc1} = pass(Forms, Fun1, _Acc = #pass1{}), |
| 180 | %% |
| 181 | %% 2nd pass - generate accessor functions |
| 182 | %% |
| 183 | Fun2 = |
| 184 | fun(attribute, {attribute,L,export_records,Es} = Form, _Ctxt, |
| 185 | #pass1{exports = [_|_] = Es} = Acc) -> |
| 186 | Exports = [{list_to_atom(fname_prefix(info)), 2}, |
| 187 | {list_to_atom(fname_prefix(get)), 2}, |
| 188 | {list_to_atom(fname_prefix(set)), 2} | |
| 189 | lists:concat( |
| 190 | lists:map( |
| 191 | fun(Rec) -> |
| 192 | FNew = fname(new, Rec), |
| 193 | [{FNew, 0}, {FNew,1}, |
| 194 | {fname(get, Rec), 2}, |
| 195 | {fname(set, Rec), 2}, |
| 196 | {fname(info, Rec), 1}] |
| 197 | end, Es))], |
| 198 | {[], |
| 199 | Form, |
| 200 | [{attribute,L,export,Exports}], |
| 201 | false, Acc}; |
| 202 | (function, Form, _Ctxt, #pass1{exports = [_|_], |
| 203 | generated = false} = Acc) -> |
| 204 | %% Layout record funs before first function |
| 205 | L = element(2, Form), |
| 206 | Funs = generate_accessors(L, Acc), |
| 207 | {Funs, Form, [], false, Acc#pass1{generated = true}}; |
| 208 | (_Type, Form, _Ctxt, Acc) -> |
| 209 | {Form, false, Acc} |
| 210 | end, |
| 211 | {Forms2, Acc2} = pass(Forms1, Fun2, Acc1), |
| 212 | case Acc2#pass1.generated of |
| 213 | true -> |
| 214 | Forms2; |
| 215 | false -> |
| 216 | case Acc2#pass1.exports of |
| 217 | [] -> |
| 218 | Forms2; |
| 219 | [_|_] -> |
| 220 | [{eof,Last}|RevForms] = lists:reverse(Forms2), |
| 221 | [{function, NewLast, _, _, _}|_] = RevAs = |
| 222 | lists:reverse(generate_accessors(Last, Acc2)), |
| 223 | lists:reverse([{eof, NewLast+1} | RevAs] ++ RevForms) |
| 224 | end |
| 225 | end. |
| 226 | |
| 227 | |
| 228 | pass(Forms, Fun, Acc) -> |
| 229 | {NewTree, NewAcc} = transform(Forms, Fun, Acc), |
| 230 | NewForms = [erl_syntax:revert(T) || T <- lists:flatten(NewTree)], |
| 231 | {NewForms, NewAcc}. |
| 232 | |
| 233 | |
| 234 | generate_accessors(L, Acc) -> |
| 235 | [f_info(Acc, L), |
| 236 | f_get(Acc, L), |
| 237 | f_set(Acc, L) | |
| 238 | lists:concat( |
| 239 | lists:map( |
| 240 | fun(Rname) -> |
| 241 | Fields = get_flds(Rname, Acc), |
| 242 | [f_new_0(Rname, L), |
| 243 | f_new_1(Rname, L), |
| 244 | f_get_2(Rname, Fields, L), |
| 245 | f_set_2(Rname, Fields, L), |
| 246 | f_info_1(Rname, L)] |
| 247 | end, Acc#pass1.exports))]. |
| 248 | |
| 249 | get_flds(Rname, #pass1{records = Rs}) -> |
| 250 | {value, {_, Flds}} = lists:keysearch(Rname, 1, Rs), |
| 251 | lists:map( |
| 252 | fun({record_field,_, {atom,_,N}}) -> N; |
| 253 | ({record_field,_, {atom,_,N}, _}) -> N |
| 254 | end, Flds). |
| 255 | |
| 256 | |
| 257 | |
| 258 | fname_prefix(Op) -> |
| 259 | case Op of |
| 260 | new -> "#new-"; |
| 261 | get -> "#get-"; |
| 262 | set -> "#set-"; |
| 263 | info -> "#info-" |
| 264 | end. |
| 265 | |
| 266 | fname(Op, Rname) -> |
| 267 | Prefix = fname_prefix(Op), |
| 268 | list_to_atom(Prefix ++ atom_to_list(Rname)). |
| 269 | |
| 270 | %%% Accessor functions |
| 271 | %%% |
| 272 | f_new_0(Rname, L) -> |
| 273 | {function, L, fname(new, Rname), 0, |
| 274 | [{clause, L, [], [], |
| 275 | [{record, L, Rname, []}]}]}. |
| 276 | |
| 277 | |
| 278 | f_new_1(Rname, L) -> |
| 279 | {function, L, fname(new, Rname), 1, |
| 280 | [{clause, L, [{var, L, 'Vals'}], [], |
| 281 | [{call, L, {atom, L, fname(set, Rname)}, |
| 282 | [{var, L, 'Vals'}, |
| 283 | {record, L, Rname, []} |
| 284 | ]}] |
| 285 | }]}. |
| 286 | |
| 287 | f_set_2(Rname, Flds, L) -> |
| 288 | {function, L, fname(set, Rname), 2, |
| 289 | [{clause, L, [{var, L, 'Vals'}, {var, L, 'Rec'}], [], |
| 290 | [{match, L, {var, L, 'F'}, |
| 291 | {'fun', L, |
| 292 | {clauses, |
| 293 | [{clause, L, [{nil,L}, |
| 294 | {var,L,'R'}, |
| 295 | {var,L,'_F1'}], |
| 296 | [], |
| 297 | [{var, L, 'R'}]} | |
| 298 | [{clause, L, |
| 299 | [{cons, L, {tuple, L, [{atom, L, Attr}, |
| 300 | {var, L, 'V'}]}, |
| 301 | {var, L, 'T'}}, |
| 302 | {var, L, 'R'}, |
| 303 | {var, L, 'F1'}], |
| 304 | [], |
| 305 | [{call, L, {var, L, 'F1'}, |
| 306 | [{var,L,'T'}, |
| 307 | {record, L, {var,L,'R'}, Rname, |
| 308 | [{record_field, L, |
| 309 | {atom, L, Attr}, |
| 310 | {var, L, 'V'}}]}, |
| 311 | {var, L, 'F1'}]}]} || Attr <- Flds]]}}}, |
| 312 | {call, L, {var, L, 'F'}, [{var, L, 'Vals'}, |
| 313 | {var, L, 'Rec'}, |
| 314 | {var, L, 'F'}]}]}]}. |
| 315 | |
| 316 | f_get_2(Rname, Flds, L) -> |
| 317 | FName = fname(get, Rname), |
| 318 | {function, L, FName, 2, |
| 319 | [{clause, L, [{var, L, 'Attrs'}, {var, L, 'R'}], |
| 320 | [[{call, L, {atom, L, is_list}, [{var, L, 'Attrs'}]}]], |
| 321 | [{lc, L, {call, L, {atom, L, FName}, [{var, L, 'A'}, {var, L, 'R'}]}, |
| 322 | [{generate, L, {var, L, 'A'}, {var, L, 'Attrs'}}]}] |
| 323 | } | |
| 324 | [{clause, L, [{atom, L, Attr}, {var, L, 'R'}], [], |
| 325 | [{record_field, L, {var, L, 'R'}, Rname, {atom, L, Attr}}]} || |
| 326 | Attr <- Flds]] |
| 327 | }. |
| 328 | |
| 329 | |
| 330 | f_info(Acc, L) -> |
| 331 | Fname = list_to_atom(fname_prefix(info)), |
| 332 | {function, L, Fname, 2, |
| 333 | [{clause, L, |
| 334 | [{var, L, 'Info'}, {var, L, 'Rec'}], |
| 335 | [[{call, L, |
| 336 | {atom, L, is_record}, |
| 337 | [{var, L, 'Rec'}, {atom, L, R}]}]], |
| 338 | [{call, L, {atom, L, fname(info, R)}, [{var, L, 'Info'}]}]} || |
| 339 | R <- Acc#pass1.exports]}. |
| 340 | |
| 341 | |
| 342 | f_get(Acc, L) -> |
| 343 | f_getset(get, Acc, L). |
| 344 | |
| 345 | f_set(Acc, L) -> |
| 346 | f_getset(set, Acc, L). |
| 347 | |
| 348 | f_getset(Mode, Acc, L) when Mode == get; Mode == set -> |
| 349 | Fname = list_to_atom(fname_prefix(Mode)), |
| 350 | {function, L, Fname, 2, |
| 351 | [{clause, L, |
| 352 | [{var, L, 'Attrs'}, |
| 353 | {var, L, 'Rec'}], |
| 354 | [[{call, L, |
| 355 | {atom, L, is_record}, |
| 356 | [{var, L, 'Rec'}, {atom, L, R}]}]], |
| 357 | [{call, L, {atom, L, fname(Mode, R)}, [{var, L, 'Attrs'}, |
| 358 | {var, L, 'Rec'}]}]} || |
| 359 | R <- Acc#pass1.exports]}. |
| 360 | |
| 361 | f_info_1(Rname, L) -> |
| 362 | {function, L, fname(info, Rname), 1, |
| 363 | [{clause, L, [{atom, L, fields}], [], |
| 364 | [{call, L, {atom, L, record_info}, |
| 365 | [{atom, L, fields}, {atom, L, Rname}]}] |
| 366 | }, |
| 367 | {clause, L, [{atom, L, size}], [], |
| 368 | [{call, L, {atom, L, record_info}, |
| 369 | [{atom, L, size}, {atom, L, Rname}]}] |
| 370 | }]}. |
| 371 | |
| 372 | %%% ========== generic parse_transform stuff ============== |
| 373 | |
| 374 | context(module, #context{module = M} ) -> M; |
| 375 | context(function, #context{function = F}) -> F; |
| 376 | context(arity, #context{arity = A} ) -> A. |
| 377 | |
| 378 | |
| 379 | transform(Forms, F, Acc) -> |
| 380 | case [{L,M} || {attribute, L, module, M} <- Forms] of |
| 381 | [{_,Module}] -> |
| 382 | transform(Forms, F, #context{module = Module}, Acc); |
| 383 | [] -> |
| 384 | ?ERROR(missing_module_attribute, ?HERE, []); |
| 385 | [_|_] = Multiple -> |
| 386 | ?ERROR(multiple_module_attributes, ?HERE, |
| 387 | [{L,{module,M}} || {L,M} <- Multiple]) |
| 388 | end. |
| 389 | |
| 390 | transform(Forms, F, Context, Acc) -> |
| 391 | F1 = |
| 392 | fun(Form, Acc0) -> |
| 393 | Type = erl_syntax:type(Form), |
| 394 | {Before1, Form1, After1, Recurse, Acc1} = |
| 395 | try F(Type, Form, Context, Acc0) of |
| 396 | {F1, Rec1, A1} -> |
| 397 | {[], F1, [], Rec1, A1}; |
| 398 | {_Be1, _F1, _Af1, _Rec1, _Ac1} = Res1 -> |
| 399 | Res1 |
| 400 | catch |
| 401 | error:Reason -> |
| 402 | ?ERROR(Reason, |
| 403 | ?HERE, |
| 404 | [{type, Type}, |
| 405 | {context, Context}, |
| 406 | {acc, Acc}, |
| 407 | {form, Form}]) |
| 408 | end, |
| 409 | if Recurse == true -> |
| 410 | case erl_syntax:subtrees(Form1) of |
| 411 | [] -> |
| 412 | {Before1, Form1, After1, Acc1}; |
| 413 | ListOfLists -> |
| 414 | {NewListOfLists, NewAcc} = |
| 415 | mapfoldl( |
| 416 | fun(L, AccX) -> |
| 417 | transform( |
| 418 | L, F, |
| 419 | new_context( |
| 420 | Form1, Context), AccX) |
| 421 | end, Acc1, ListOfLists), |
| 422 | NewForm = |
| 423 | erl_syntax:update_tree( |
| 424 | Form, NewListOfLists), |
| 425 | {Before1, NewForm, After1, NewAcc} |
| 426 | end; |
| 427 | true -> |
| 428 | {Before1, Form1, After1, Acc1} |
| 429 | end |
| 430 | end, |
| 431 | mapfoldl(F1, Acc, Forms). |
| 432 | |
| 433 | |
| 434 | new_context(Form, Context0) -> |
| 435 | case erl_syntax:type(Form) of |
| 436 | function -> |
| 437 | {Fun, Arity} = |
| 438 | erl_syntax_lib:analyze_function(Form), |
| 439 | Context0#context{function = Fun, |
| 440 | arity = Arity}; |
| 441 | _ -> |
| 442 | Context0 |
| 443 | end. |
| 444 | |
| 445 | |
| 446 | |
| 447 | |
| 448 | %%% Slightly modified version of lists:mapfoldl/3 |
| 449 | %%% Here, F/2 is able to insert forms before and after the form |
| 450 | %%% in question. The inserted forms are not transformed afterwards. |
| 451 | mapfoldl(F, Accu0, [Hd|Tail]) -> |
| 452 | {Before, Res, After, Accu1} = |
| 453 | case F(Hd, Accu0) of |
| 454 | {Be, _, Af, _} = Result when is_list(Be), is_list(Af) -> |
| 455 | Result; |
| 456 | {R1, A1} -> |
| 457 | {[], R1, [], A1} |
| 458 | end, |
| 459 | {Rs, Accu2} = mapfoldl(F, Accu1, Tail), |
| 460 | {Before ++ [Res| After ++ Rs], Accu2}; |
| 461 | mapfoldl(F, Accu, []) when is_function(F, 2) -> {[], Accu}. |
| 462 | |
| 463 | |
| 464 | |
| 465 | rpt_error(Reason, Fun, Info) -> |
| 466 | Fmt = lists:flatten( |
| 467 | ["*** ERROR in parse_transform function:~n" |
| 468 | "*** Reason = ~p~n", |
| 469 | "*** Location: ~p~n", |
| 470 | ["*** ~10w = ~p~n" || _ <- Info]]), |
| 471 | Args = [Reason, Fun | |
| 472 | lists:foldr( |
| 473 | fun({K,V}, Acc) -> |
| 474 | [K, V | Acc] |
| 475 | end, [], Info)], |
| 476 | io:format(Fmt, Args). |
| 477 | |
| 478 | |
| 479 | format_error({_Cat, Error}) -> |
| 480 | Error. |