From 676ed9a44b0131f480bd2812eaae996edf6ffc56 Mon Sep 17 00:00:00 2001 From: Ulf Wiger Date: Tue, 25 Oct 2011 14:11:00 -0700 Subject: [PATCH] pretty_print handles typed records; exprecs gets more type specs --- examples/Makefile | 7 +- examples/exprecs_eunit.erl | 2 +- examples/test_exprecs.erl | 3 +- src/exprecs.erl | 313 ++++++++++++++++++++++++------------- src/parse_trans.erl | 10 +- src/parse_trans_pp.erl | 5 +- 6 files changed, 222 insertions(+), 118 deletions(-) diff --git a/examples/Makefile b/examples/Makefile index 2c749b9..c0eee6b 100644 --- a/examples/Makefile +++ b/examples/Makefile @@ -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 diff --git a/examples/exprecs_eunit.erl b/examples/exprecs_eunit.erl index cfa5b1f..7f850ae 100644 --- a/examples/exprecs_eunit.erl +++ b/examples/exprecs_eunit.erl @@ -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)). diff --git a/examples/test_exprecs.erl b/examples/test_exprecs.erl index 13aa537..b97a94b 100644 --- a/examples/test_exprecs.erl +++ b/examples/test_exprecs.erl @@ -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() -> diff --git a/src/exprecs.erl b/src/exprecs.erl index 8d9bd2a..871d165 100755 --- a/src/exprecs.erl +++ b/src/exprecs.erl @@ -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, diff --git a/src/parse_trans.erl b/src/parse_trans.erl index 9c049f9..39bb7b3 100644 --- a/src/parse_trans.erl +++ b/src/parse_trans.erl @@ -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] diff --git a/src/parse_trans_pp.erl b/src/parse_trans_pp.erl index 2bcf0a1..868f393 100644 --- a/src/parse_trans_pp.erl +++ b/src/parse_trans_pp.erl @@ -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))])