pretty_print handles typed records; exprecs gets more type specs

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
 
+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

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)).

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() ->

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) ->
+    [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)]}]}.
+	[erl_parse:abstract(Es, L)]}]}
+    ].
 
 %%% Accessor functions
 %%%
 f_new_(#pass1{exports = Es}, L) ->
+    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]}.
+       || 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,10 +474,12 @@ 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_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}]}.
@@ -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,24 +629,34 @@ 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)),
+    [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],
+    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}) ->
@@ -626,43 +672,69 @@ f_isrec_2(Acc, L) ->
 		 [{atom, L, true}]}
 	end, Info) ++
 	  [{clause, L, [{var,L,'_'}, {var,L,'_'}], [],
-       [{atom, L, false}]}]}.
+	    [{atom, L, false}]}]}
+    ].
 
 
 f_info_2(Acc, L) ->
     Fname = list_to_atom(fname_prefix(info)),
+    [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]}.
+	  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)),
+    [
+     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]}.
+	  R <- Acc#pass1.exports]}
+    ].
 
 f_isrec_1(Acc, L) ->
     Fname = list_to_atom(fname_prefix(isrec)),
+    [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'}],
@@ -673,12 +745,22 @@ f_isrec_1(Acc, L) ->
 	    [{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)),
+    [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'},
@@ -688,11 +770,18 @@ f_get(Acc, L) ->
 	   [{var, L, 'Rec'}, {atom, L, R}]}]],
 	[{call, L, {atom, L, fname(get, R)}, [{var, L, 'Attrs'},
 					      {var, L, 'Rec'}]}]} ||
-	 R <- Acc#pass1.exports]}.
+	  R <- Es]}
+    ].
 
 
 f_set(Acc, L) ->
     Fname = list_to_atom(fname_prefix(set)),
+    [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'},
@@ -702,10 +791,17 @@ f_set(Acc, L) ->
 	   [{var, L, 'Rec'}, {atom, L, R}]}]],
 	[{call, L, {atom, L, fname(set, R)}, [{var, L, 'Vals'},
 					      {var, L, 'Rec'}]}]} ||
-	 R <- Acc#pass1.exports]}.
+	  R <- Acc#pass1.exports]}
+    ].
 
 f_fromlist(Acc, L) ->
     Fname = list_to_atom(fname_prefix(fromlist)),
+    [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'},
@@ -715,7 +811,8 @@ f_fromlist(Acc, L) ->
 	   [{var, L, 'Rec'}, {atom, L, R}]}]],
 	[{call, L, {atom, L, fname(fromlist, R)}, [{var, L, 'Vals'},
 						   {var, L, 'Rec'}]}]} ||
-	 R <- Acc#pass1.exports]}.
+	  R <- Acc#pass1.exports]}
+    ].
 
 f_info_1(Rname, L) ->
     {function, L, fname(info, Rname), 1,

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]

src/parse_trans_pp.erl

@@ -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))])