aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/src/compiler/diameter_exprecs.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/diameter/src/compiler/diameter_exprecs.erl')
-rw-r--r--lib/diameter/src/compiler/diameter_exprecs.erl301
1 files changed, 301 insertions, 0 deletions
diff --git a/lib/diameter/src/compiler/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl
new file mode 100644
index 0000000000..5e120d6f44
--- /dev/null
+++ b/lib/diameter/src/compiler/diameter_exprecs.erl
@@ -0,0 +1,301 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Parse transform for generating record access functions
+%%
+%% This parse transform can be used to reduce compile-time
+%% dependencies in large systems.
+%%
+%% In the old days, before records, Erlang programmers often wrote
+%% access functions for tuple data. This was tedious and error-prone.
+%% The record syntax made this easier, but since records were implemented
+%% fully in the pre-processor, a nasty compile-time dependency was
+%% introduced.
+%%
+%% This module automates the generation of access functions for
+%% records. While this method cannot fully replace the utility of
+%% pattern matching, it does allow a fair bit of functionality on
+%% records without the need for compile-time dependencies.
+%%
+%% Whenever record definitions need to be exported from a module,
+%% inserting a compiler attribute,
+%%
+%% export_records([RecName, ...])
+%%
+%% causes this transform to lay out access functions for the exported
+%% records:
+%%
+%% -module(foo)
+%% -compile({parse_transform, diameter_exprecs}).
+%%
+%% -record(r, {a, b, c}).
+%% -export_records([a]).
+%%
+%% -export(['#info-'/1, '#info-'/2,
+%% '#new-'/1, '#new-'/2,
+%% '#get-'/2, '#set-'/2,
+%% '#new-a'/0, '#new-a'/1,
+%% '#get-a'/2, '#set-a'/2,
+%% '#info-a'/1]).
+%%
+%% '#info-'(RecName) ->
+%% '#info-'(RecName, fields).
+%%
+%% '#info-'(r, Info) ->
+%% '#info-r'(Info).
+%%
+%% '#new-'(r) -> #r{}.
+%% '#new-'(r, Vals) -> '#new-r'(Vals)
+%%
+%% '#new-r'() -> #r{}.
+%% '#new-r'(Vals) -> '#set-r'(Vals, #r{}).
+%%
+%% '#get-'(Attrs, #r{} = Rec) ->
+%% '#get-r'(Attrs, Rec).
+%%
+%% '#get-r'(Attrs, Rec) when is_list(Attrs) ->
+%% ['#get-r'(A, Rec) || A <- Attrs];
+%% '#get-r'(a, Rec) -> Rec#r.a;
+%% '#get-r'(b, Rec) -> Rec#r.b;
+%% '#get-r'(c, Rec) -> Rec#r.c.
+%%
+%% '#set-'(Vals, #r{} = Rec) ->
+%% '#set-r'(Vals, Rec).
+%%
+%% '#set-r'(Vals, Rec) when is_list(Vals) ->
+%% lists:foldl(fun '#set-r'/2, Rec, Vals);
+%% '#set-r'({a,V}, Rec) -> Rec#r{a = V};
+%% '#set-r'({b,V}, Rec) -> Rec#r{b = V};
+%% '#set-r'({c,V}, Rec) -> Rec#r{c = V}.
+%%
+%% '#info-r'(fields) -> record_info(fields, r);
+%% '#info-r'(size) -> record_info(size, r);
+%% '#info-r'({index, a}) -> 1;
+%% '#info-r'({index, b}) -> 2;
+%% '#info-r'({index, c}) -> 3;
+%%
+
+-module(diameter_exprecs).
+
+-export([parse_transform/2]).
+
+%% Form tag with line number.
+-define(F(T), T, ?LINE).
+%% Yes, that's right. The replacement is to the first unmatched ')'.
+
+-define(attribute, ?F(attribute)).
+-define(clause, ?F(clause)).
+-define(function, ?F(function)).
+-define(call, ?F(call)).
+-define('fun', ?F('fun')).
+-define(generate, ?F(generate)).
+-define(lc, ?F(lc)).
+-define(match, ?F(match)).
+-define(remote, ?F(remote)).
+-define(record, ?F(record)).
+-define(record_field, ?F(record_field)).
+-define(record_index, ?F(record_index)).
+-define(tuple, ?F(tuple)).
+
+-define(ATOM(T), {atom, ?LINE, T}).
+-define(VAR(V), {var, ?LINE, V}).
+
+-define(CALL(F,A), {?call, ?ATOM(F), A}).
+-define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}).
+
+%% parse_transform/2
+
+parse_transform(Forms, _Options) ->
+ Rs = [R || {attribute, _, record, R} <- Forms],
+ case lists:append([E || {attribute, _, export_records, E} <- Forms]) of
+ [] ->
+ Forms;
+ Es ->
+ {H,T} = lists:splitwith(fun is_head/1, Forms),
+ H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T
+ end.
+
+is_head(T) ->
+ not lists:member(element(1,T), [function, eof]).
+
+%% a_export/1
+
+a_export(Exports) ->
+ {?attribute, export, [{fname(info), 1},
+ {fname(info), 2},
+ {fname(new), 1},
+ {fname(new), 2},
+ {fname(get), 2},
+ {fname(set), 2}
+ | lists:flatmap(fun export/1, Exports)]}.
+
+export(Rname) ->
+ New = fname(new, Rname),
+ [{New, 0},
+ {New, 1},
+ {fname(get, Rname), 2},
+ {fname(set, Rname), 2},
+ {fname(info, Rname), 1}].
+
+%% f_accessors/2
+
+f_accessors(Es, Rs) ->
+ ['#info-/1'(),
+ '#info-/2'(Es),
+ '#new-/1'(Es),
+ '#new-/2'(Es),
+ '#get-/2'(Es),
+ '#set-/2'(Es)
+ | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)].
+
+accessors(Rname, Fields) ->
+ ['#new-X/0'(Rname),
+ '#new-X/1'(Rname),
+ '#get-X/2'(Rname, Fields),
+ '#set-X/2'(Rname, Fields),
+ '#info-X/1'(Rname, Fields)].
+
+fields(Rname, Recs) ->
+ {Rname, Fields} = lists:keyfind(Rname, 1, Recs),
+ lists:map(fun({record_field, _, {atom, _, N}}) -> N;
+ ({record_field, _, {atom, _, N}, _}) -> N
+ end,
+ Fields).
+
+fname_prefix(Op) ->
+ "#" ++ atom_to_list(Op) ++ "-".
+
+fname(Op) ->
+ list_to_atom(fname_prefix(Op)).
+
+fname(Op, Rname) ->
+ Prefix = fname_prefix(Op),
+ list_to_atom(Prefix ++ atom_to_list(Rname)).
+
+%% Generated functions.
+
+'#info-/1'() ->
+ Fname = fname(info),
+ {?function, Fname, 1,
+ [{?clause, [?VAR('RecName')],
+ [],
+ [?CALL(Fname, [?VAR('RecName'), ?ATOM(fields)])]}]}.
+
+'#info-/2'(Exports) ->
+ {?function, fname(info), 2,
+ lists:map(fun 'info-'/1, Exports)}.
+
+'info-'(R) ->
+ {?clause, [?ATOM(R), ?VAR('Info')],
+ [],
+ [?CALL(fname(info, R), [?VAR('Info')])]}.
+
+'#new-/1'(Exports) ->
+ {?function, fname(new), 1,
+ lists:map(fun 'new-'/1, Exports)}.
+
+'new-'(R) ->
+ {?clause, [?ATOM(R)],
+ [],
+ [{?record, R, []}]}.
+
+'#new-/2'(Exports) ->
+ {?function, fname(new), 2,
+ lists:map(fun 'new--'/1, Exports)}.
+
+'new--'(R) ->
+ {?clause, [?ATOM(R), ?VAR('Vals')],
+ [],
+ [?CALL(fname(new, R), [?VAR('Vals')])]}.
+
+'#get-/2'(Exports) ->
+ {?function, fname(get), 2,
+ lists:map(fun 'get-'/1, Exports)}.
+
+'get-'(R) ->
+ {?clause, [?VAR('Attrs'),
+ {?match, {?record, R, []}, ?VAR('Rec')}],
+ [],
+ [?CALL(fname(get, R), [?VAR('Attrs'), ?VAR('Rec')])]}.
+
+'#set-/2'(Exports) ->
+ {?function, fname(set), 2,
+ lists:map(fun 'set-'/1, Exports)}.
+
+'set-'(R) ->
+ {?clause, [?VAR('Vals'), {?match, {?record, R, []}, ?VAR('Rec')}],
+ [],
+ [?CALL(fname(set, R), [?VAR('Vals'), ?VAR('Rec')])]}.
+
+'#new-X/0'(Rname) ->
+ {?function, fname(new, Rname), 0,
+ [{?clause, [],
+ [],
+ [{?record, Rname, []}]}]}.
+
+'#new-X/1'(Rname) ->
+ {?function, fname(new, Rname), 1,
+ [{?clause, [?VAR('Vals')],
+ [],
+ [?CALL(fname(set, Rname), [?VAR('Vals'), {?record, Rname, []}])]}]}.
+
+'#set-X/2'(Rname, Fields) ->
+ {?function, fname(set, Rname), 2,
+ [{?clause, [?VAR('Vals'), ?VAR('Rec')],
+ [[?CALL(is_list, [?VAR('Vals')])]],
+ [?APPLY(lists, foldl, [{?'fun', {function, fname(set, Rname), 2}},
+ ?VAR('Rec'),
+ ?VAR('Vals')])]}
+ | lists:map(fun(A) -> 'set-X'(Rname, A) end, Fields)]}.
+
+'set-X'(Rname, Attr) ->
+ {?clause, [{?tuple, [?ATOM(Attr), ?VAR('V')]}, ?VAR('Rec')],
+ [],
+ [{?record, ?VAR('Rec'), Rname,
+ [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}.
+
+'#get-X/2'(Rname, Fields) ->
+ FName = fname(get, Rname),
+ {?function, FName, 2,
+ [{?clause, [?VAR('Attrs'), ?VAR('Rec')],
+ [[?CALL(is_list, [?VAR('Attrs')])]],
+ [{?lc, ?CALL(FName, [?VAR('A'), ?VAR('Rec')]),
+ [{?generate, ?VAR('A'), ?VAR('Attrs')}]}]}
+ | lists:map(fun(A) -> 'get-X'(Rname, A) end, Fields)]}.
+
+'get-X'(Rname, Attr) ->
+ {?clause, [?ATOM(Attr), ?VAR('Rec')],
+ [],
+ [{?record_field, ?VAR('Rec'), Rname, ?ATOM(Attr)}]}.
+
+'#info-X/1'(Rname, Fields) ->
+ {?function, fname(info, Rname), 1,
+ [{?clause, [?ATOM(fields)],
+ [],
+ [?CALL(record_info, [?ATOM(fields), ?ATOM(Rname)])]},
+ {?clause, [?ATOM(size)],
+ [],
+ [?CALL(record_info, [?ATOM(size), ?ATOM(Rname)])]}
+ | lists:map(fun(A) -> 'info-X'(Rname, A) end, Fields)]}.
+
+'info-X'(Rname, Attr) ->
+ {?clause, [{?tuple, [?ATOM(index), ?ATOM(Attr)]}],
+ [],
+ [{?record_index, Rname, ?ATOM(Attr)}]}.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 22:04:40 +0000