valitydev/parse_trans
14
0
Fork 0
mirror of https://github.com/valitydev/parse_trans.git synced 2024-11-06 00:25:16 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

pretty_print handles typed records; exprecs gets more type specs

Browse Source
This commit is contained in:
Ulf Wiger 2011-10-25 14:11:00 -07:00
parent bb57e235ff
commit 676ed9a44b
6 changed files with 222 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
examples/Makefile
View File

@ -10,13 +10,16 @@ test: $(APPLICATION) $(TEST_BEAMS) ../util/run_test.beam
@echo Running tests
@erl -pa ../util/ -pa ../ebin/ -pa test/ -noinput -s run_test run
%.beam: %.erl $(HEADERS)
test_exprecs.beam: ../ebin/exprecs.beam
@echo Compiling test_exprecs.erl
@erlc +debug_info -pa ../ebin -pa . -I ../include test_exprecs.erl
%.beam: %.erl $(HEADERS)
@echo Compiling $<
@erlc +debug_info -pa ../ebin -pa . -I ../include $<
test.beam: test_pt.beam
test_exprecs.erl: ../ebin/exprecs.beam
clean:
@echo Cleaning

2
examples/exprecs_eunit.erl
View File

@ -31,4 +31,4 @@ test_record(R, M) ->
?assertError(bad_record_op, M:'#get-'(17,Rec1)),
PosL = lists:seq(2, FieldCount + 1),
PosL = [M:'#pos-'(R, A) || A <- Fields],
?assertEqual(0, M:'#pos-'(R, 17)).
?assertEqual(0, M:'#pos-'(R, bad_attr_name)).

3
examples/test_exprecs.erl
View File

@ -7,8 +7,9 @@
-compile({parse_transform, exprecs}).
-record(r, {a = 0 :: integer(), b = 0 :: integer(), c = 0 :: integer()}).
-record(s, {a}).
-export_records([r]).
-export_records([r, s]).
f() ->

313
src/exprecs.erl
View File

@ -179,11 +179,26 @@ parse_transform(Forms, Options) ->
do_transform(Forms, Context) ->
Acc1 = versioned_records(
parse_trans:do_inspect(fun inspect_f/4, #pass1{}, Forms, Context)),
add_untyped_recs(
parse_trans:do_inspect(fun inspect_f/4, #pass1{},
Forms, Context))),
{Forms2, Acc2} =
parse_trans:do_transform(fun generate_f/4, Acc1, Forms, Context),
parse_trans:revert(verify_generated(Forms2, Acc2, Context)).
add_untyped_recs(#pass1{records = Rs,
record_types = RTypes,
exports = Es} = Acc) ->
Untyped =
[{R, Def} || {R, Def} <- Rs,
lists:member(R, Es),
not lists:keymember(R, 1, RTypes)],
RTypes1 = [{R, lists:map(
fun({record_field,L,{atom,_,A}}) -> {A, t_any(L)};
({record_field,L,{atom,_,A},_}) -> {A, t_any(L)}
end, Def)} || {R, Def} <- Untyped],
Acc#pass1{record_types = RTypes ++ RTypes1}.
inspect_f(attribute, {attribute,_L,record,RecDef}, _Ctxt, Acc) ->
Recs0 = Acc#pass1.records,
{false, Acc#pass1{records = [RecDef|Recs0]}};
@ -349,7 +364,7 @@ generate_accessors(L, Acc) ->
Fields = get_flds(Rname, Acc),
[f_new_0(Rname, L),
f_new_1(Rname, L),
f_get_2(Rname, Fields, L),
f_get_2(Rname, Fields, Acc, L),
f_set_2(Rname, Fields, L),
f_fromlist_1(Rname, L),
f_fromlist_2(Rname, Fields, L),
@ -402,27 +417,32 @@ fname(Op, Rname, V) ->
%%% Meta functions
f_exported_recs(#pass1{exports = Es}, L) ->
{function, L, '#exported-records', 0,
[{clause, L, [], [],
[erl_parse:abstract(Es, L)]}]}.
[funspec(L, '#exported-records', [],
t_list(L, [t_union(L, [t_atom(L, E) || E <- Es])])),
{function, L, '#exported-records', 0,
[{clause, L, [], [],
[erl_parse:abstract(Es, L)]}]}
].
%%% Accessor functions
%%%
f_new_(#pass1{exports = Es}, L) ->
{function, L, fname(new), 1,
[{clause, L, [{atom, L, Re}], [],
[{call, L, {atom, L, fname(new, Re)}, []}]}
|| Re <- Es]}.
Fname = fname(new),
[funspec(L, Fname, [ {[t_atom(L, E)], t_record(L, E)} ||
E <- Es ]),
{function, L, fname(new), 1,
[{clause, L, [{atom, L, Re}], [],
[{call, L, {atom, L, fname(new, Re)}, []}]}
|| Re <- Es]}
].
f_new_0(Rname, L) ->
Fname = fname(new, Rname),
[{attribute, L, spec,
{{Fname, 0},
[{type, L, 'fun',
[{type, L, product, []}, {type, L, record, [{atom, L, Rname}]}]}]}},
[funspec(L, Fname, [], t_record(L, Rname)),
{function, L, fname(new, Rname), 0,
[{clause, L, [], [],
[{record, L, Rname, []}]}]}].
[{record, L, Rname, []}]}]}
].
f_new_1(Rname, L) ->
@ -437,6 +457,13 @@ f_new_1(Rname, L) ->
]}]
}]}].
funspec(L, Fname, [{H,_} | _] = Alts) ->
Arity = length(H),
{attribute, L, spec,
{{Fname, Arity},
[{type, L, 'fun', [{type, L, product, Head}, Ret]} ||
{Head, Ret} <- Alts]}}.
funspec(L, Fname, Head, Returns) ->
Arity = length(Head),
{attribute, L, spec,
@ -447,13 +474,15 @@ funspec(L, Fname, Head, Returns) ->
t_prop(L, Rname) -> {type, L, fname(prop, Rname), []}.
t_attr(L, Rname) -> {type, L, fname(attr, Rname), []}.
t_union(L, Alt) -> {type, L, union, Alt}.
%% t_any(L) -> {type, L, any, []}.
t_atom(L) -> {type, L, atom, []}.
t_integer(L) -> {type, L, integer, []}.
t_list(L, Es) -> {type, L, list, Es}.
t_union(L, Alt) -> {type, L, union, lists:usort(Alt)}.
t_any(L) -> {type, L, any, []}.
t_atom(L) -> {type, L, atom, []}.
t_atom(L, A) -> {atom, L, A}.
t_integer(L) -> {type, L, integer, []}.
t_integer(L, I) -> {integer, L, I}.
t_list(L, Es) -> {type, L, list, Es}.
%% t_tuple(L, Es) -> {type, L, tuple, Es}.
t_record(L, A) -> {type, L, record, [{atom, L, A}]}.
t_record(L, A) -> {type, L, record, [{atom, L, A}]}.
f_set_2(Rname, Flds, L) ->
Fname = fname(set, Rname),
@ -584,8 +613,15 @@ field_list(Flds) ->
f_get_2(Rname, Flds, L) ->
FName = fname(get, Rname),
f_get_2(R, Flds, Acc, L) ->
FName = fname(get, R),
{_, Types} = lists:keyfind(R, 1, Acc#pass1.record_types),
[funspec(L, FName,
[{[t_atom(L, A), t_record(L, R)], T}
|| {A, T} <- Types]
++ [{[t_list(L, [t_attr(L, R)]), t_record(L, R)],
t_list(L, [t_union(L, [Ts || {_, Ts} <- Types])])}]
),
{function, L, FName, 2,
[{clause, L, [{var, L, 'Attrs'}, {var, L, 'R'}],
[[{call, L, {atom, L, is_list}, [{var, L, 'Attrs'}]}]],
@ -593,129 +629,190 @@ f_get_2(Rname, Flds, L) ->
[{generate, L, {var, L, 'A'}, {var, L, 'Attrs'}}]}]
} |
[{clause, L, [{atom, L, Attr}, {var, L, 'R'}], [],
[{record_field, L, {var, L, 'R'}, Rname, {atom, L, Attr}}]} ||
[{record_field, L, {var, L, 'R'}, R, {atom, L, Attr}}]} ||
Attr <- Flds]] ++
[{clause, L, [{var, L, 'Attr'}, {var, L, 'R'}], [],
[bad_record_op(L, FName, 'Attr', 'R')]}]
}.
}].
f_info(_Acc, L) ->
f_info(Acc, L) ->
Fname = list_to_atom(fname_prefix(info)),
{function, L, Fname, 1,
[{clause, L,
[{var, L, 'RecName'}], [],
[{call, L, {atom, L, Fname}, [{var, L, 'RecName'}, {atom, L, fields}]}]
}]}.
[funspec(L, Fname,
[{[t_atom(L, R)],
t_list(L, [t_union(L, [t_atom(L,A) ||
A <- get_flds(R, Acc)])])}
|| R <- Acc#pass1.exports]),
{function, L, Fname, 1,
[{clause, L,
[{var, L, 'RecName'}], [],
[{call, L, {atom, L, Fname}, [{var, L, 'RecName'}, {atom, L, fields}]}]
}]}
].
f_isrec_2(Acc, L) ->
f_isrec_2(#pass1{records = Rs, exports = Es}, L) ->
Fname = list_to_atom(fname_prefix(isrec)),
Info = [{R,length(As) + 1} || {R,As} <- Acc#pass1.records],
{function, L, Fname, 2,
lists:map(
fun({R, Ln}) ->
{clause, L,
[{atom, L, R}, {var, L, 'Rec'}],
[[{op,L,'==',
{call, L, {atom,L,tuple_size},[{var,L,'Rec'}]},
{integer, L, Ln}},
{op,L,'==',
{call,L,{atom,L,element},[{integer,L,1},
{var,L,'Rec'}]},
{atom, L, R}}]],
[{atom, L, true}]}
end, Info) ++
[{clause, L, [{var,L,'_'}, {var,L,'_'}], [],
[{atom, L, false}]}]}.
Info = [{R,length(As) + 1} || {R,As} <- Rs, lists:member(R, Es)],
[funspec(L, Fname,
[{[t_atom(L, R), t_record(L, R)], t_atom(L, true)}
|| R <- Es] ++
[{[t_any(L), t_any(L)], t_atom(L, false)}]),
{function, L, Fname, 2,
lists:map(
fun({R, Ln}) ->
{clause, L,
[{atom, L, R}, {var, L, 'Rec'}],
[[{op,L,'==',
{call, L, {atom,L,tuple_size},[{var,L,'Rec'}]},
{integer, L, Ln}},
{op,L,'==',
{call,L,{atom,L,element},[{integer,L,1},
{var,L,'Rec'}]},
{atom, L, R}}]],
[{atom, L, true}]}
end, Info) ++
[{clause, L, [{var,L,'_'}, {var,L,'_'}], [],
[{atom, L, false}]}]}
].
f_info_2(Acc, L) ->
Fname = list_to_atom(fname_prefix(info)),
{function, L, Fname, 2,
[{clause, L,
[{atom, L, R},
{var, L, 'Info'}],
[],
[{call, L, {atom, L, fname(info, R)}, [{var, L, 'Info'}]}]} ||
R <- Acc#pass1.exports]}.
[funspec(L, Fname,
lists:flatmap(
fun(Rname) ->
Flds = get_flds(Rname, Acc),
TRec = t_atom(L, Rname),
[{[TRec, t_atom(L, size)], t_integer(L, length(Flds)+1)},
{[TRec, t_atom(L, fields)],
t_list(L, [t_union(L, [t_atom(L, F) || F <- Flds])])}]
end, Acc#pass1.exports)),
{function, L, Fname, 2,
[{clause, L,
[{atom, L, R},
{var, L, 'Info'}],
[],
[{call, L, {atom, L, fname(info, R)}, [{var, L, 'Info'}]}]} ||
R <- Acc#pass1.exports]}
].
f_info_3(Versions, L) ->
Fname = list_to_atom(fname_prefix(info)),
F = {function, L, Fname, 3,
[
{function, L, Fname, 3,
[{clause, L,
[{atom, L, R},
{var, L, 'Info'},
{string, L, V}],
[],
[{call, L, {atom, L, fname(info,R,V)}, [{var, L, 'Info'}]}]} ||
{R,V} <- flat_versions(Versions)]},
F.
{R,V} <- flat_versions(Versions)]}
].
f_pos_2(Acc, L) ->
f_pos_2(#pass1{exports = Es} = Acc, L) ->
Fname = list_to_atom(fname_prefix(pos)),
{function, L, Fname, 2,
[{clause, L,
[{atom, L, R},
{var, L, 'Attr'}],
[],
[{call, L, {atom, L, fname(pos, R)}, [{var, L, 'Attr'}]}]} ||
R <- Acc#pass1.exports]}.
[
funspec(L, Fname, lists:flatmap(
fun(R) ->
Flds = get_flds(R, Acc),
PFlds = lists:zip(
lists:seq(1, length(Flds)), Flds),
[{[t_atom(L, R), t_atom(L, A)],
t_integer(L, P)} || {P,A} <- PFlds]
end, Es)),
{function, L, Fname, 2,
[{clause, L,
[{atom, L, R},
{var, L, 'Attr'}],
[],
[{call, L, {atom, L, fname(pos, R)}, [{var, L, 'Attr'}]}]} ||
R <- Acc#pass1.exports]}
].
f_isrec_1(Acc, L) ->
Fname = list_to_atom(fname_prefix(isrec)),
{function, L, Fname, 1,
[{clause, L,
[{var, L, 'X'}],
[],
[{'if',L,
[{clause, L, [], [[{call, L, {atom,L,is_record},
[{var,L,'X'},{atom,L,R}]}]],
[{atom,L,true}]} || R <- Acc#pass1.exports] ++
[{clause,L, [], [[{atom,L,true}]],
[{atom, L, false}]}]}]}
]}.
[funspec(L, Fname,
[{[t_record(L, R)], t_atom(L, true)}
|| R <- Acc#pass1.exports]
++ [{[t_any(L)], t_atom(L, false)}]),
{function, L, Fname, 1,
[{clause, L,
[{var, L, 'X'}],
[],
[{'if',L,
[{clause, L, [], [[{call, L, {atom,L,is_record},
[{var,L,'X'},{atom,L,R}]}]],
[{atom,L,true}]} || R <- Acc#pass1.exports] ++
[{clause,L, [], [[{atom,L,true}]],
[{atom, L, false}]}]}]}
]}
].
f_get(Acc, L) ->
f_get(#pass1{record_types = RTypes, exports = Es}, L) ->
Fname = list_to_atom(fname_prefix(get)),
{function, L, Fname, 2,
[{clause, L,
[{var, L, 'Attrs'},
{var, L, 'Rec'}],
[[{call, L,
{atom, L, is_record},
[{var, L, 'Rec'}, {atom, L, R}]}]],
[{call, L, {atom, L, fname(get, R)}, [{var, L, 'Attrs'},
{var, L, 'Rec'}]}]} ||
R <- Acc#pass1.exports]}.
[funspec(L, Fname,
lists:concat(
[[{[t_atom(L, A), t_record(L, R)], T}
|| {A, T} <- Types]
|| {R, Types} <- RTypes])
++ [{[t_list(L, [t_attr(L, R)]), t_record(L, R)],
t_list(L, [t_union(L, [Ts || {_, Ts} <- Types])])}
|| {R, Types} <- RTypes]
),
{function, L, Fname, 2,
[{clause, L,
[{var, L, 'Attrs'},
{var, L, 'Rec'}],
[[{call, L,
{atom, L, is_record},
[{var, L, 'Rec'}, {atom, L, R}]}]],
[{call, L, {atom, L, fname(get, R)}, [{var, L, 'Attrs'},
{var, L, 'Rec'}]}]} ||
R <- Es]}
].
f_set(Acc, L) ->
Fname = list_to_atom(fname_prefix(set)),
{function, L, Fname, 2,
[{clause, L,
[{var, L, 'Vals'},
{var, L, 'Rec'}],
[[{call, L,
{atom, L, is_record},
[{var, L, 'Rec'}, {atom, L, R}]}]],
[{call, L, {atom, L, fname(set, R)}, [{var, L, 'Vals'},
{var, L, 'Rec'}]}]} ||
R <- Acc#pass1.exports]}.
[funspec(L, Fname,
lists:map(
fun(Rname) ->
TRec = t_record(L, Rname),
{[t_list(L, [t_prop(L, Rname)]), TRec], TRec}
end, Acc#pass1.exports)),
{function, L, Fname, 2,
[{clause, L,
[{var, L, 'Vals'},
{var, L, 'Rec'}],
[[{call, L,
{atom, L, is_record},
[{var, L, 'Rec'}, {atom, L, R}]}]],
[{call, L, {atom, L, fname(set, R)}, [{var, L, 'Vals'},
{var, L, 'Rec'}]}]} ||
R <- Acc#pass1.exports]}
].
f_fromlist(Acc, L) ->
Fname = list_to_atom(fname_prefix(fromlist)),
{function, L, Fname, 2,
[{clause, L,
[{var, L, 'Vals'},
{var, L, 'Rec'}],
[[{call, L,
{atom, L, is_record},
[{var, L, 'Rec'}, {atom, L, R}]}]],
[{call, L, {atom, L, fname(fromlist, R)}, [{var, L, 'Vals'},
{var, L, 'Rec'}]}]} ||
R <- Acc#pass1.exports]}.
[funspec(L, Fname,
lists:map(
fun(Rname) ->
TRec = t_record(L, Rname),
{[t_list(L, [t_prop(L, Rname)]), TRec], TRec}
end, Acc#pass1.exports)),
{function, L, Fname, 2,
[{clause, L,
[{var, L, 'Vals'},
{var, L, 'Rec'}],
[[{call, L,
{atom, L, is_record},
[{var, L, 'Rec'}, {atom, L, R}]}]],
[{call, L, {atom, L, fname(fromlist, R)}, [{var, L, 'Vals'},
{var, L, 'Rec'}]}]} ||
R <- Acc#pass1.exports]}
].
f_info_1(Rname, L) ->
{function, L, fname(info, Rname), 1,

10
src/parse_trans.erl
View File

@ -90,7 +90,8 @@
-define(ERROR(R, F, I),
begin
rpt_error(R, F, I),
Trace = erlang:get_stacktrace(),
rpt_error(R, F, I, Trace),
throw({error,get_pos(I),{unknown,R}})
end).
@ -120,7 +121,7 @@
-spec error(string(), any(), [{any(),any()}]) ->
none().
error(R, F, I) ->
rpt_error(R, F, I),
rpt_error(R, F, I, erlang:get_stacktrace()),
throw({error,get_pos(I),{unknown,R}}).
@ -604,13 +605,14 @@ mapfoldl(F, Accu0, [Hd|Tail]) ->
mapfoldl(F, Accu, []) when is_function(F, 2) -> {[], Accu}.
rpt_error(Reason, Fun, Info) ->
rpt_error(Reason, Fun, Info, Trace) ->
Fmt = lists:flatten(
["*** ERROR in parse_transform function:~n"
"*** Reason = ~p~n",
"*** Location: ~p~n",
"*** Trace: ~p~n",
["*** ~10w = ~p~n" || _ <- Info]]),
Args = [Reason, Fun |
Args = [Reason, Fun, Trace |
lists:foldr(
fun({K,V}, Acc) ->
[K, V | Acc]

5
src/parse_trans_pp.erl
View File

@ -86,7 +86,7 @@ pp_beam(Beam) ->
%% @spec (Beam::filename(), Out::filename()) -> ok | {error, Reason}
%%
%% @doc
%% Reads debug_info from the beam file Beam and pretty-prints it as
%% Reads debug_info from the beam file Beam and pretty-prints it as
%% Erlang source code, storing it in the file Out.
%% @end
%%
@ -101,7 +101,8 @@ pp_beam(F, Out) ->
pp_beam_to_str(F) ->
case beam_lib:chunks(F, [abstract_code]) of
{ok, {_, [{abstract_code,{_,AC}}]}} ->
{ok, {_, [{abstract_code,{_,AC0}}]}} ->
AC = epp:restore_typed_record_fields(AC0),
{ok, lists:flatten(
%% io_lib:fwrite("~s~n", [erl_prettypr:format(
%% erl_syntax:form_list(AC))])