%%% The contents of this file are subject to the Erlang Public License, %%% Version 1.0, (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/license/EPL1_0.txt %%% %%% 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 ___ %%% %%% The Initial Developer of the Original Code is Ericsson Telecom %%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson %%% Telecom AB. All Rights Reserved. %%% %%% Contributor(s): ______________________________________. %%% %%% ------------------------------------------------------------------ -module(vp_expand). -id(''). -vsn(''). -date('2007-07-26'). -author('ulf.wiger@ericsson.com'). -import(erl_syntax, [type/1, application_operator/1, revert/1, case_expr/2, clause/2, application_arguments/1, application/2, list/1, list_elements/1]). %%% This module is a quick hack to allow for use of view patterns. %%% See http://www.erlang.org/pipermail/erlang-questions/2007-July/028075.html %%% %%% The syntax suggested by Richard O'Keefe: %%% %%% The idea is that if E is an expression and P is a pattern, then %%% (E -> P) %%% is a pattern. This pattern matches a value V if and only if %%% P = (E)(V). %%% %%% Since the above is not (yet) valid Erlang syntax, this parse transform %%% Recognizes view patterns on the following form: %%% %%% _:_(E, Args, P) %%% %%% which will be transformed into something corresponding to %%% P = apply(E, Args ++ [V]) %%% %%% Example: %%% %%% np(K, X) when integer(X), integer(K), X >= K -> %%% {X-K}; %%% np(_, _) -> %%% false. %%% %%% factorial(0) -> 1; %%% factorial(_:_(np,[1], {N})) -> %%% mul(N+1,factorial(N)). %%% %%% Currently, view patterns are only supported in function heads, %%% and no effort is made to optimize repeating patterns. -export([parse_transform/2]). -export([format_error/1]). -define(ERROR(R, T, F, I), begin rpt_error(R, T, F, I), throw({error,erl_syntax:get_pos( proplists:get_value(form,I)),{unknown,R}}) end). -import(erl_syntax, [clause/3, clause_patterns/1, clause_body/1, clause_guard/1, match_expr/2, function_clauses/1, get_pos/1, add_ann/2, get_ann/1]). parse_transform(Forms, _Options) -> [File|_] = [F || {attribute,_,file,{F,_}} <- Forms], try begin NewTree = xform(Forms, [{file, File}]), revert_tree(NewTree) end catch throw:{error,Ln,What} -> {error, [{File, [{Ln,?MODULE,What}]}], []} end. revert_tree(Tree) -> [erl_syntax:revert(T) || T <- lists:flatten(Tree)]. format_error(Other) -> lists:flatten( io_lib:format("unknown error in parse_transform: ~p", [Other])). xform(Forms, Context0) -> Bef = fun(function, Form, Ctxt) -> {Fname, Arity} = erl_syntax_lib:analyze_function(Form), VarNames = erl_syntax_lib:new_variable_names( Arity, erl_syntax_lib:variables(Form)), Clauses = function_clauses(Form), Clauses1 = [rewrite_clause(C, VarNames) || C <- Clauses], Form1 = erl_syntax:function( erl_syntax:function_name(Form), Clauses1), {Form1, [{function, Fname}, {arity, Arity}, {var_names, VarNames}|Ctxt]}; (_, Form, Context) -> {Form, Context} end, Aft = fun(_, Form, _Context) -> Form end, [Module] = [Mx || {attribute, _, module, Mx} <- Forms], transform(Forms, Bef, Aft, [{module, Module}|Context0]). rewrite_clause(C, VarNames) -> Pats = clause_patterns(C), PVs = lists:zip(Pats, VarNames), case [{P,V} || {P,V} <- PVs, is_pat(P)] of [] -> C; [_|_] = _ViewPats -> Pats1 = [case is_pat(P) of true -> v(V); false -> P end || {P,V} <- PVs], erl_syntax:clause(Pats1, erl_syntax:clause_guard(C), wrap_body(PVs, erl_syntax:clause_body(C))) end. wrap_body([], B) -> B; wrap_body([{Pat,V}|T], B) -> {Eval, Expr} = _X = pat_eval(Pat, V), [case_expr(Eval, [clause([Expr], [], wrap_body(T, B)), clause([v('_')], [], [function_clause()])])]. pat_eval(Pat, V) -> case application_arguments(Pat) of [Fn, Args, Expr] -> {application(Fn, list_elements(Args) ++ [v(V)]), Expr}; _ -> erlang:error(invalid_pattern) end. function_clause() -> {call, 1, {remote, 1, {atom, 1, erlang}, {atom, 1, error}}, [{atom, 1, function_clause}]}. is_pat(Form) -> case type(Form) of application -> case application_operator(Form) of {remote,_,{var,_,'_'},{var,_,'_'}} -> true end; _ -> false end. %%% library functions transform(Forms, Before, After, Context) -> F1 = fun(Form) -> Type = erl_syntax:type(Form), {Form1, Context1} = try Before(Type, Form, Context) catch error:Reason -> ?ERROR(Reason, 'before', Before, [{type, Type}, {context, Context}, {form, Form}, {trace, erlang:get_stacktrace()}]) end, Form2 = case erl_syntax:subtrees(Form1) of [] -> Form1; List -> NewList = transform( List, Before, After, Context1), erl_syntax:update_tree(Form, NewList) end, Type2 = erl_syntax:type(Form2), try After(Type2, Form2, Context1) catch error:Reason2 -> ?ERROR(Reason2, 'after', After, [{type, Type2}, {context, Context1}, {form, Form2}, {trace, erlang:get_stacktrace()}]) end end, F2 = fun(List) when is_list(List) -> map(F1, List); (Form) -> F1(Form) end, map(F2, Forms). %%% Slightly modified version of lists:mapfoldl/3 %%% Here, F/2 is able to insert forms before and after the form %%% in question. The inserted forms are not transformed afterwards. map(F, [Hd|Tail]) -> {Before, Res, After} = case F(Hd) of {Be, _, Af} = Result when is_list(Be), is_list(Af) -> Result; R1 -> {[], R1, []} end, Rs = map(F, Tail), Before ++ [Res| After ++ Rs]; map(F, []) when is_function(F, 1) -> []. rpt_error(Reason, BeforeOrAfter, Fun, Info) -> Fmt = lists:flatten( ["*** ERROR in parse_transform function:~n" "*** Reason = ~p~n" "*** applying ~w fun (~p)~n", ["*** ~10w = ~p~n" || _ <- Info]]), Args = [Reason, BeforeOrAfter, Fun | lists:foldr( fun({K,V}, Acc) -> [K, V | Acc] end, [], Info)], io:format(Fmt, Args). v(V) -> erl_syntax:variable(V).