add parse_trans_mod & transform example

examples/ex1.erl

@@ -3,3 +3,6 @@
 
 add(X,Y) ->
     X + Y.
+
+int() ->
+    int.

examples/test_transform_mod.erl

@@ -0,0 +1,17 @@
+-module(test_transform_mod).
+-export([ex1/0]).
+
+-include("codegen.hrl").
+
+ex1() ->
+    parse_trans_mod:transform_module(
+      ex1, [fun(Fs, _Os) ->
+		    parse_trans:export_function(int, 0, Fs)
+	    end,
+	    fun transform_ex1/2], []).
+
+transform_ex1(Forms, _Opts) ->
+    NewF = codegen:gen_function(add, fun(A, B) ->
+					     A - B
+				     end),
+    parse_trans:replace_function(add, 2, NewF, Forms).

src/ct_expand.erl

@@ -20,17 +20,17 @@
 %% File    : ct_expand.erl
 %% @author  : Ulf Wiger <ulf.wiger@erlang-solutions.com>
 %% @end
-%% Description : 
+%% Description :
 %%
 %% Created : 7 Apr 2010 by Ulf Wiger <ulf.wiger@erlang-solutions.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 
+%% 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
@@ -51,7 +51,7 @@
 -spec parse_transform(forms(), options()) ->
     forms().
 parse_transform(Forms, Options) ->
-    {NewForms,_} = 
+    {NewForms,_} =
         parse_trans:depth_first(fun xform_fun/4, [], Forms, Options),
     parse_trans:revert(NewForms).
 
@@ -75,4 +75,4 @@ xform_fun(application, Form, _Ctxt, Acc) ->
     end;
 xform_fun(_, Form, _Ctxt, Acc) ->
     {Form, Acc}.
-  
+

src/parse_trans.erl

@@ -20,13 +20,13 @@
 %%% File    : parse_trans.erl
 %%% @author  : Ulf Wiger <ulf.wiger@erlang-consulting.com>
 %%% @end
-%%% Description : 
+%%% Description :
 %%%
 %%% Created : 13 Feb 2006 by Ulf Wiger <ulf.wiger@erlang-consulting.com>
 %%%-------------------------------------------------------------------
 
 %%% @doc Generic parse transform library for Erlang.
-%%% 
+%%%
 %%% <p>...</p>
 %%%
 %%% @end
@@ -53,7 +53,9 @@
 	 top/3
         ]).
 
--export([do_insert_forms/4]).
+-export([do_insert_forms/4,
+	 replace_function/4,
+	 export_function/3]).
 
 -export([
          context/2,
@@ -106,7 +108,7 @@
 				 {form(), Acc}
 				     | {forms(), form(), forms(), Acc}).
 -type insp_f()  :: fun((type(), form(), #context{}, A) -> {boolean(), A}).
-                              
+
 
 %%% @spec (Reason, Form, Info) -> throw()
 %%% Info = [{Key,Value}]
@@ -125,7 +127,7 @@ error(R, F, I) ->
 %% @spec (list()) -> integer()
 %%
 %% @doc
-%% Tries to retrieve the line number from an erl_syntax form. Returns a 
+%% Tries to retrieve the line number from an erl_syntax form. Returns a
 %% (very high) dummy number if not successful.
 %% @end
 %%
@@ -211,7 +213,7 @@ function_exists(Fname, Arity, Forms) ->
 %%%
 %%% @doc
 %%% Initializes a context record. When traversing through the form
-%%% list, the context is updated to reflect the current function and 
+%%% list, the context is updated to reflect the current function and
 %%% arity. Static elements in the context are the file name, the module
 %%% name and the options passed to the transform function.
 %%% @end
@@ -279,6 +281,24 @@ top(F, Forms, Options) ->
 	    {error, [{File, [{Ln, ?MODULE, What}]}], []}
     end.
 
+replace_function(F, Arity, NewForm, Forms) ->
+    {NewForms, _} =
+	do_transform(
+	  fun(function, Form, _Ctxt, Acc) ->
+		  case erl_syntax:revert(Form) of
+		      {function, _, F, Arity, _} ->
+			  {NewForm, false, Acc};
+		      _ ->
+			  {Form, false, Acc}
+		  end;
+	     (_, Form, _Ctxt, Acc) ->
+		  {Form, false, Acc}
+	  end, false, Forms, false),
+    revert(NewForms).
+
+export_function(F, Arity, Forms) ->
+    do_insert_forms(above, [{attribute, 1, export, [{F, Arity}]}], Forms, false).
+
 -spec do_insert_forms(above | below, forms(), forms(), #context{}) ->
     forms().
 do_insert_forms(above, Insert, Forms, Context) when is_list(Insert) ->
@@ -359,7 +379,6 @@ outfile(File, Type) ->
 
 ext(pp)    -> ".xfm";
 ext(forms) -> ".xforms".
-
 
 %% @spec (Forms, Out::filename()) -> ok
 %%
@@ -387,7 +406,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
 %%
@@ -419,7 +438,7 @@ get_orig_syntax_tree(File) ->
 %%%
 %%% @doc Reverts back from Syntax Tools format to Erlang forms.
 %%% <p>Note that the Erlang forms are a subset of the Syntax Tools
-%%% syntax tree, so this function is safe to call even on a list of 
+%%% syntax tree, so this function is safe to call even on a list of
 %%% regular Erlang forms.</p>
 %%% @end
 %%%
@@ -431,7 +450,7 @@ revert(Tree) ->
 
 %%% @spec (Attr, Context) -> any()
 %%% Attr = module | function | arity | options
-%%% 
+%%%
 %%% @doc
 %%% Accessor function for the Context record.
 %%% @end
@@ -448,7 +467,7 @@ context(options,  #context{options = O} ) -> O.
     term().
 do_inspect(F, Acc, Forms, Context) ->
 %%    io:fwrite("do_inspect/4~n", []),
-    F1 = 
+    F1 =
         fun(Form, Acc0) ->
                 Type = type(Form),
                 {Recurse, Acc1} = apply_F(F, Type, Form, Context, Acc0),
@@ -505,7 +524,6 @@ do_depth_first(F, Acc, Forms, Context) ->
                 this_form_df(F, NewForm, Context, NewAcc)
         end,
     mapfoldl(F1, Acc, Forms).
-
 
 enter_subtrees(Form, F, Context, Acc, Recurse) ->
     case erl_syntax:subtrees(Form) of
@@ -540,9 +558,6 @@ this_form_df(F, Form, Context, Acc) ->
         {_Be1, _F1, _Af1, _Ac1} = Res1 ->
             Res1
     end.
-
-
-
 
 apply_F(F, Type, Form, Context, Acc) ->
     try F(Type, Form, Context, Acc)
@@ -594,7 +609,7 @@ rpt_error(Reason, Fun, Info) ->
 	     "*** Reason     = ~p~n",
              "*** Location: ~p~n",
 	     ["*** ~10w = ~p~n" || _ <- Info]]),
-    Args = [Reason, Fun | 
+    Args = [Reason, Fun |
 	    lists:foldr(
 	      fun({K,V}, Acc) ->
 		      [K, V | Acc]

src/parse_trans_codegen.erl

@@ -24,7 +24,7 @@
 %%%-------------------------------------------------------------------
 
 %%% @doc Parse transform for code generation pseduo functions
-%%% 
+%%%
 %%% <p>...</p>
 %%%
 %%% @end
@@ -42,8 +42,8 @@
 %% representing the abstract form of that code.
 %%
 %% The purpose of these functions is to let the programmer write
-%% the actual code that is to be generated, rather than manually 
-%% writing abstract forms, which is more error prone and cannot be 
+%% the actual code that is to be generated, rather than manually
+%% writing abstract forms, which is more error prone and cannot be
 %% checked by the compiler until the generated module is compiled.
 %%
 %% Supported functions:
@@ -55,16 +55,16 @@
 %% Substitutes the abstract code for a function with name `Name'
 %% and the same behaviour as `Fntun'.
 %%
-%% `Fun' can either be a anonymous `fun', which is then converted to 
-%% a named function. It can also be an `implicit fun', e.g. 
+%% `Fun' can either be a anonymous `fun', which is then converted to
+%% a named function. It can also be an `implicit fun', e.g.
 %% `fun is_member/2'. In this case, the referenced function is fetched
-%% and converted to an abstract form representation. It is also renamed 
+%% and converted to an abstract form representation. It is also renamed
 %% so that the generated function has the name `Name'.
 %%
 %% <h2>gen_functions/1</h2>
 %%
 %% Takes a list of `{Name, Fun}' tuples and produces a list of abstract
-%% data objects, just as if one had written 
+%% data objects, just as if one had written
 %% `[codegen:gen_function(N1,F1),codegen:gen_function(N2,F2),...]'.
 %%
 %% <h2>exprs/1</h2>
@@ -78,7 +78,7 @@
 %% used to ensure that all necessary variables are known to the compiler.
 %%
 %% <h2>Variable substitution</h2>
-%% 
+%%
 %% It is possible to do some limited expansion (importing a value
 %% bound at compile-time), using the construct <code>{'$var', V}</code>, where
 %% `V' is a bound variable in the scope of the call to `gen_function/2'.
@@ -89,7 +89,7 @@
 %%    codegen:gen_function(Name, fun(L) -> lists:member({'$var',X}, L) end).
 %% </pre>
 %%
-%% After transformation, calling `gen(contains_17, 17)' will yield the 
+%% After transformation, calling `gen(contains_17, 17)' will yield the
 %% abstract form corresponding to:
 %% <pre>
 %% contains_17(L) ->
@@ -122,7 +122,7 @@ parse_transform(Forms, Options) ->
     parse_trans:revert(NewForms).
 
 xform_fun(application, Form, _Ctxt, Acc) ->
-    MFA = erl_syntax_lib:analyze_application(Form), 
+    MFA = erl_syntax_lib:analyze_application(Form),
     case MFA of
 	{codegen, {gen_function, 2}} ->
 	    [NameF, FunF] =
@@ -190,8 +190,6 @@ find_function(Name, Arity, Forms) ->
 abstract_clauses(ClauseForms) ->
     Abstract = erl_parse:abstract(parse_trans:revert(ClauseForms)),
     substitute(Abstract).
-
-
 
 substitute({tuple,L0,
 	    [{atom,_,tuple},

src/parse_trans_mod.erl

@@ -0,0 +1,107 @@
+%%============================================================================
+%% Copyright 2011 Erlang Solutions Ltd.
+%%
+%% Licensed under the Apache License, Version 2.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.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%============================================================================
+%%
+%% Based on meck_mod.erl from http://github.com/esl/meck.git
+%% Original author: Adam Lindberg
+%%
+-module(parse_trans_mod).
+%% Interface exports
+-export([transform_module/3]).
+
+-export([abstract_code/1]).
+-export([beam_file/1]).
+-export([compile_and_load_forms/1]).
+-export([compile_and_load_forms/2]).
+-export([compile_options/1]).
+-export([rename_module/2]).
+
+%% Types
+-type erlang_form() :: term().
+-type compile_options() :: [term()].
+
+%%============================================================================
+%% Interface exports
+%%============================================================================
+
+transform_module(Mod, PT, Options) ->
+    Forms = abstract_code(beam_file(Mod)),
+    PTMods = if is_atom(PT) -> [PT];
+		is_function(PT, 2) -> [PT];
+		is_list(PT) -> PT
+	     end,
+    Transformed = lists:foldl(fun(PTx, Fs) when is_function(PTx, 2) ->
+				      PTx(Fs, Options);
+				 (PTMod, Fs) ->
+				      PTMod:parse_transform(Fs, Options)
+			      end, Forms, PTMods),
+    compile_and_load_forms(Transformed, Options).
+
+
+-spec abstract_code(binary()) -> erlang_form().
+abstract_code(BeamFile) ->
+    case beam_lib:chunks(BeamFile, [abstract_code]) of
+        {ok, {_, [{abstract_code, {raw_abstract_v1, Forms}}]}} ->
+            Forms;
+        {ok, {_, [{abstract_code, no_abstract_code}]}} ->
+            error(no_abstract_code)
+    end.
+
+-spec beam_file(module()) -> binary().
+beam_file(Module) ->
+    % code:which/1 cannot be used for cover_compiled modules
+    case code:get_object_code(Module) of
+        {_, Binary, _Filename} -> Binary;
+        error                  -> throw({object_code_not_found, Module})
+    end.
+
+-spec compile_and_load_forms(erlang_form()) -> ok.
+compile_and_load_forms(AbsCode) -> compile_and_load_forms(AbsCode, []).
+
+-spec compile_and_load_forms(erlang_form(), compile_options()) -> ok.
+compile_and_load_forms(AbsCode, Opts) ->
+    case compile:forms(AbsCode, Opts) of
+        {ok, ModName, Binary} ->
+            load_binary(ModName, Binary);
+        {ok, ModName, Binary, _Warnings} ->
+            load_binary(ModName, Binary)
+    end.
+
+-spec compile_options(binary() | module()) -> compile_options().
+compile_options(BeamFile) when is_binary(BeamFile) ->
+    case beam_lib:chunks(BeamFile, [compile_info]) of
+        {ok, {_, [{compile_info, Info}]}} ->
+            proplists:get_value(options, Info);
+        _ ->
+            []
+    end;
+compile_options(Module) ->
+    proplists:get_value(options, Module:module_info(compile)).
+
+-spec rename_module(erlang_form(), module()) -> erlang_form().
+rename_module([{attribute, Line, module, _OldName}|T], NewName) ->
+    [{attribute, Line, module, NewName}|T];
+rename_module([H|T], NewName) ->
+    [H|rename_module(T, NewName)].
+
+%%==============================================================================
+%% Internal functions
+%%==============================================================================
+
+load_binary(Name, Binary) ->
+    case code:load_binary(Name, "", Binary) of
+        {module, Name}  -> ok;
+        {error, Reason} ->  exit({error_loading_module, Name, Reason})
+    end.