nicer error reporting; more capable ct_expand

examples/ct_expand_test.erl

@@ -11,4 +11,28 @@ f() ->
        {b, ct_expand:term(
              [{ba, 1},
               {bb, ct_expand:term(2)}])}]).
-
+
+%% expand a term which calls a local function - even one which uses a fun reference.
+g() ->
+    ct_expand:term(zip([1,2], [a,b])).
+
+%% this doesn't work: a function in the expanded expr returns a fun, which is then passed
+%% to another function. This is because erl_eval returns results as concrete terms, which
+%% must then be abstracted in order to be passed as input arguments to am interpreted
+%% function. This works most of the time, but erl_parse:abstract/1 crashes on funs.
+%%
+%% h() ->
+%%     ct_expand:term(wrap(my_fun())).
+
+zip([H1|T1], [H2|T2]) ->
+    F = fun wrap/1,
+    [{F(H1),F(H2)} | zip(T1, T2)];
+zip([], []) ->
+    [].
+
+wrap(X) ->
+    {X}.
+
+my_fun() ->
+    fun() -> foo end.
+

src/ct_expand.erl

@@ -39,6 +39,17 @@
 %%
 %% would be expanded at compile-time to `[1,2,3,4,5]'.
 %%
+%% ct_expand has now been extended to also evaluate calls to local functions.
+%% See examples/ct_expand_test.erl for some examples, and also limitations.
+%% Specifically, using functions that return funs, that are then passed to other
+%% functions, doesn't work.
+%%
+%% A debugging facility exists: passing the option {ct_expand_trace, Flags} as an option,
+%% or adding a compiler attribute -ct_expand_trace(Flags) will enable a form of call trace.
+%%
+%% `Flags' can be `[]' (no trace) or `[F]', where `F' is `c' (call trace),
+%% `r' (return trace), or `x' (exception trace)'.
+%%
 %% @end
 -module(ct_expand).
 -export([parse_transform/2]).
@@ -51,18 +62,39 @@
 -spec parse_transform(forms(), options()) ->
     forms().
 parse_transform(Forms, Options) ->
-    {NewForms,_} =
-        parse_trans:depth_first(fun xform_fun/4, [], Forms, Options),
-    parse_trans:revert(NewForms).
+    Trace = ct_trace_opt(Options, Forms),
+    case parse_trans:depth_first(fun(T,F,C,A) ->
+					 xform_fun(T,F,C,A,Forms, Trace)
+				 end, [], Forms, Options) of
+	{error, Es} ->
+	    Es ++ Forms;
+	{NewForms, _} ->
+	    parse_trans:revert(NewForms)
+    end.
 
+ct_trace_opt(Options, Forms) ->
+    case proplists:get_value(ct_expand_trace, Options) of
+	undefined ->
+	    case [Opt || {attribute,_,ct_expand_trace,Opt} <- Forms] of
+		[] ->
+		    [];
+		[_|_] = L ->
+		    lists:last(L)
+	    end
+    end.
 
-xform_fun(application, Form, _Ctxt, Acc) ->
+xform_fun(application, Form, _Ctxt, Acc, Forms, Trace) ->
     MFA = erl_syntax_lib:analyze_application(Form),
     case MFA of
         {?MODULE, {term, 1}} ->
-            Args = erl_syntax:application_arguments(Form),
+	    LFH = fun(Name, Args, Bs) ->
+			  eval_lfun(
+			    extract_fun(Name, length(Args), Forms),
+			    Args, Bs, Forms, Trace)
+		  end,
+	    Args = erl_syntax:application_arguments(Form),
             RevArgs = parse_trans:revert(Args),
-            case erl_eval:exprs(RevArgs, []) of
+            case erl_eval:exprs(RevArgs, [], {eval, LFH}) of
                 {value, Value,[]} ->
                     {erl_syntax:abstract(Value), Acc};
                 Other ->
@@ -73,6 +105,65 @@ xform_fun(application, Form, _Ctxt, Acc) ->
         _ ->
             {Form, Acc}
     end;
-xform_fun(_, Form, _Ctxt, Acc) ->
+xform_fun(_, Form, _Ctxt, Acc, _, _) ->
     {Form, Acc}.
 
+extract_fun(Name, Arity, Forms) ->
+    case [F_ || {function,_,N_,A_,_Cs} = F_ <- Forms,
+		N_ == Name, A_ == Arity] of
+	[] ->
+	    erlang:error({undef, [{Name, Arity}]});
+	[FForm] ->
+	    FForm
+    end.
+
+eval_lfun({function,L,F,_,Clauses}, Args, Bs, Forms, Trace) ->
+    try
+	begin
+	    {ArgsV, Bs1} = lists:mapfoldl(
+			     fun(A, Bs_) ->
+				     {value,AV,Bs1_} =
+					 erl_eval:expr(A, Bs_, lfh(Forms, Trace)),
+				     {erl_parse:abstract(AV), Bs1_}
+			     end, Bs, Args),
+	    Expr = {call, L, {'fun', L, {clauses, lfun_rewrite(Clauses, Forms)}}, ArgsV},
+	    call_trace(Trace =/= [], L, F, ArgsV),
+	    {value, Ret, _} =
+		erl_eval:expr(Expr, erl_eval:new_bindings(), lfh(Forms, Trace)),
+	    ret_trace(lists:member(r, Trace) orelse lists:member(x, Trace),
+		      L, F, Args, Ret),
+	    %% restore bindings
+	    {value, Ret, Bs1}
+	end
+    catch
+	error:Err ->
+	    exception_trace(lists:member(x, Trace), L, F, Args, Err),
+	    error(Err)
+    end.
+
+lfh(Forms, Trace) ->
+    {eval, fun(Name, As, Bs1) ->
+		   eval_lfun(
+		     extract_fun(Name, length(As), Forms),
+		     As, Bs1, Forms, Trace)
+	   end}.
+
+call_trace(false, _, _, _) -> ok;
+call_trace(true, L, F, As) ->
+    io:fwrite("ct_expand (~w): call ~w(~p)~n", [L, F, As]).
+
+ret_trace(_, _, _, _, _) -> ok.
+
+exception_trace(false, _, _, _, _) -> ok;
+exception_trace(true, L, F, Args, Err) ->
+    io:fwrite("ct_expand (~w): exception from ~w/~w: ~p~n", [L, F, length(Args), Err]).
+
+
+lfun_rewrite(Exprs, Forms) ->
+    parse_trans:plain_transform(
+      fun({'fun',L,{function,F,A}}) ->
+	      {function,_,_,_,Cs} = extract_fun(F, A, Forms),
+	      {'fun',L,{clauses, Cs}};
+	 (_) ->
+	      continue
+      end, Exprs).

src/parse_trans.erl

@@ -94,7 +94,7 @@
         begin
 	    Trace = erlang:get_stacktrace(),
             rpt_error(R, F, I, Trace),
-            throw({error,get_pos(I),{unknown,R}})
+            throw({error,get_pos(I),{R, Trace}})
         end).
 
 -export_type([forms/0]).
@@ -123,8 +123,8 @@
 -spec error(string(), any(), [{any(),any()}]) ->
     none().
 error(R, F, I) ->
-    rpt_error(R, F, I, erlang:get_stacktrace()),
-    throw({error,get_pos(I),{unknown,R}}).
+    % rpt_error(R, F, I, erlang:get_stacktrace()),
+    throw({error,get_pos(I),{R, erlang:get_stacktrace()}}).
 
 %% @spec plain_transform(Fun, Forms) -> forms()
 %% Fun = function()
@@ -139,6 +139,7 @@ error(R, F, I) ->
 %%
 %% `Fun(Form)' must return either of the following:
 %%
+%% * `NewForm' - any valid form
 %% * `continue' - dig into the sub-expressions of the form
 %% * `{done, NewForm}' - Replace `Form' with `NewForm'; return all following
 %%   forms unchanged
@@ -308,19 +309,23 @@ depth_first(Fun, Acc, Forms, Options) when is_function(Fun, 4) ->
     do(fun do_depth_first/4, Fun, Acc, Forms, Options).
 
 do(Transform, Fun, Acc, Forms, Options) ->
-    Context = initial_context(Forms, Options),
-    File = Context#context.file,
-    try Transform(Fun, Acc, Forms, Context) of
-	{NewForms, _} = Result when is_list(NewForms) ->
-            optionally_pretty_print(NewForms, Options, Context),
-            Result
-    catch
-        error:Reason ->
-            {error,
-             [{File, [{?DUMMY_LINE, ?MODULE,
-                       {Reason, erlang:get_stacktrace()}}]}]};
-	throw:{error, Ln, What} ->
-	    {error, [{File, [{Ln, ?MODULE, What}]}], []}
+    case [E || {error,_} = E <- Forms] of
+	[_|_] -> {error, []};
+	[] ->
+	    Context = initial_context(Forms, Options),
+	    File = Context#context.file,
+	    try Transform(Fun, Acc, Forms, Context) of
+		{NewForms, _} = Result when is_list(NewForms) ->
+		    optionally_pretty_print(NewForms, Options, Context),
+		    Result
+	    catch
+		error:Reason ->
+		    {error,
+		     [{File, [{?DUMMY_LINE, ?MODULE,
+			       {Reason, erlang:get_stacktrace()}}]}]};
+		throw:{error, Ln, What} ->
+		    {error, [{error, {Ln, ?MODULE, What}}]}
+	    end
     end.
 
 -spec top(function(), forms(), list()) ->
@@ -631,7 +636,8 @@ apply_F(F, Type, Form, Context, Acc) ->
                     {context, Context},
                     {acc, Acc},
                     {apply_f, F},
-                    {form, Form}])
+                    {form, Form}]
+		  ++ [{stack, erlang:get_stacktrace()}])
     end.
 
 
@@ -665,21 +671,32 @@ mapfoldl(F, Accu0, [Hd|Tail]) ->
 mapfoldl(F, Accu, []) when is_function(F, 2) -> {[], Accu}.
 
 
-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, Trace |
-	    lists:foldr(
-	      fun({K,V}, Acc) ->
-		      [K, V | Acc]
-	      end, [], Info)],
-    io:format(Fmt, Args).
+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, Trace |
+    %% 	    lists:foldr(
+    %% 	      fun({K,V}, Acc) ->
+    %% 		      [K, V | Acc]
+    %% 	      end, [], Info)],
+    %%io:format(Fmt, Args),
+    ok.
 
 -spec format_error({atom(), term()}) ->
     iolist().
-format_error({_Cat, Error}) ->
-    Error.
+format_error({E, [{M,F,A}|_]} = Error) ->
+    try lists:flatten(io_lib:fwrite("~p in ~s:~s/~s", [E, atom_to_list(M),
+						       atom_to_list(F), integer_to_list(A)]))
+    catch
+	error:_ ->
+	    format_error_(Error)
+    end;
+format_error(Error) ->
+    format_error_(Error).
+
+format_error_(Error) ->
+    lists:flatten(io_lib:fwrite("~p", [Error])).