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/parse_trans.erl

@@ -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,
@@ -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) ->
@@ -360,7 +380,6 @@ outfile(File, Type) ->
 ext(pp)    -> ".xfm";
 ext(forms) -> ".xforms".
 
-
 %% @spec (Forms, Out::filename()) -> ok
 %%
 %% @doc Pretty-prints the erlang source code corresponding to Forms into Out
@@ -506,7 +525,6 @@ do_depth_first(F, Acc, Forms, Context) ->
         end,
     mapfoldl(F1, Acc, Forms).
 
-
 enter_subtrees(Form, F, Context, Acc, Recurse) ->
     case erl_syntax:subtrees(Form) of
         [] ->
@@ -541,9 +559,6 @@ this_form_df(F, Form, Context, Acc) ->
             Res1
     end.
 
-                                               
-                
-
 apply_F(F, Type, Form, Context, Acc) ->
     try F(Type, Form, Context, Acc)
     catch

src/parse_trans_codegen.erl

@@ -191,8 +191,6 @@ abstract_clauses(ClauseForms) ->
     Abstract = erl_parse:abstract(parse_trans:revert(ClauseForms)),
     substitute(Abstract).
 
-
-
 substitute({tuple,L0,
 	    [{atom,_,tuple},
 	     {integer,_,L},

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.