Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

240 lines (215 sloc) 7.498 kb
%%% 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 may obtain a copy of the License at
%%% http://www.erlang.org/EPLICENSE
%%
%% 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.
%%
%% The Original Code is exprecs-0.2.
%%
%% The Initial Developer of the Original Code is Ericsson AB.
%% Portions created by Ericsson are Copyright (C), 2006, Ericsson AB.
%% All Rights Reserved.
%%
%% Contributor(s): ______________________________________.
%%-------------------------------------------------------------------
%% File : ct_expand.erl
%% @author : Ulf Wiger <ulf@feuerlabs.com>
%% @end
%% Description :
%%
%% Created : 7 Apr 2010 by Ulf Wiger <ulf@feuerlabs.com>
%%-------------------------------------------------------------------
%% @doc Compile-time expansion utility
%%
%% This module serves as an example of parse_trans-based transforms,
%% but might also be a useful utility in its own right.
%% The transform searches for calls to the pseudo-function
%% `ct_expand:term(Expr)', and then replaces the call site with the
%% result of evaluating `Expr' at compile-time.
%%
%% For example, the line
%%
%% `ct_expand:term(lists:sort([3,5,2,1,4]))'
%%
%% 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.
%%
%% 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]).
-export([extract_fun/3,
lfun_rewrite/2]).
-type form() :: any().
-type forms() :: [form()].
-type options() :: [{atom(), any()}].
-spec parse_transform(forms(), options()) ->
forms().
parse_transform(Forms, Options) ->
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;
Flags when is_list(Flags) ->
Flags
end.
xform_fun(application, Form, _Ctxt, Acc, Forms, Trace) ->
MFA = erl_syntax_lib:analyze_application(Form),
case MFA of
{?MODULE, {term, 1}} ->
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, [], {eval, LFH}) of
{value, Value,[]} ->
{abstract(Value), Acc};
Other ->
parse_trans:error(cannot_evaluate,?LINE,
[{expr, RevArgs},
{error, Other}])
end;
_ ->
{Form, Acc}
end;
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)),
{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 ~s~n", [L, pp_function(F, As)]).
pp_function(F, []) ->
atom_to_list(F) ++ "()";
pp_function(F, [A|As]) ->
lists:flatten([atom_to_list(F), "(",
[io_lib:fwrite("~w", [erl_parse:normalise(A)]) |
[[",", io_lib:fwrite("~w", [erl_parse:normalise(A_)])] || A_ <- As]],
")"]).
ret_trace(false, _, _, _, _) -> ok;
ret_trace(true, L, F, Args, Res) ->
io:fwrite("ct_expand (~w): returned from ~w/~w: ~w~n",
[L, F, length(Args), Res]).
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).
%% abstract/1 - modified from erl_eval:abstract/1:
-type abstract_expr() :: term().
-spec abstract(Data) -> AbsTerm when
Data :: term(),
AbsTerm :: abstract_expr().
abstract(T) when is_function(T) ->
case erlang:fun_info(T, module) of
{module, erl_eval} ->
case erl_eval:fun_data(T) of
{fun_data, _Imports, Clauses} ->
{'fun', 0, {clauses, Clauses}};
false ->
erlang:error(function_clause) % mimicking erl_parse:abstract(T)
end;
_ ->
erlang:error(function_clause)
end;
abstract(T) when is_integer(T) -> {integer,0,T};
abstract(T) when is_float(T) -> {float,0,T};
abstract(T) when is_atom(T) -> {atom,0,T};
abstract([]) -> {nil,0};
abstract(B) when is_bitstring(B) ->
{bin, 0, [abstract_byte(Byte, 0) || Byte <- bitstring_to_list(B)]};
abstract([C|T]) when is_integer(C), 0 =< C, C < 256 ->
abstract_string(T, [C]);
abstract([H|T]) ->
{cons,0,abstract(H),abstract(T)};
abstract(Tuple) when is_tuple(Tuple) ->
{tuple,0,abstract_list(tuple_to_list(Tuple))}.
abstract_string([C|T], String) when is_integer(C), 0 =< C, C < 256 ->
abstract_string(T, [C|String]);
abstract_string([], String) ->
{string, 0, lists:reverse(String)};
abstract_string(T, String) ->
not_string(String, abstract(T)).
not_string([C|T], Result) ->
not_string(T, {cons, 0, {integer, 0, C}, Result});
not_string([], Result) ->
Result.
abstract_list([H|T]) ->
[abstract(H)|abstract_list(T)];
abstract_list([]) ->
[].
abstract_byte(Byte, Line) when is_integer(Byte) ->
{bin_element, Line, {integer, Line, Byte}, default, default};
abstract_byte(Bits, Line) ->
Sz = bit_size(Bits),
<<Val:Sz>> = Bits,
{bin_element, Line, {integer, Line, Val}, {integer, Line, Sz}, default}.
Jump to Line
Something went wrong with that request. Please try again.