diff --git a/.gitignore b/.gitignore index b89b9a2..4932fcc 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,9 @@ +*.swp .eunit deps *.o *.beam -*.plt \ No newline at end of file +*.plt +ebin +doc +.vim diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..e454a52 --- /dev/null +++ b/LICENSE @@ -0,0 +1,178 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..c7b4342 --- /dev/null +++ b/Makefile @@ -0,0 +1,30 @@ +EAOP_HOME = . +EBIN = ${EAOP_HOME}/ebin +SRC = ${EAOP_HOME}/src + +MODS = eaop eaopcore eaoputil eaopweaver + +all: compile erl + +erl: + erl -pa ${EBIN} + +ebin: + mkdir ${EBIN} + +compile: ebin ${MODS:%=${EBIN}/%.beam} + +${EBIN}/eaop.beam: ${SRC}/eaop.erl + erlc -o ${EBIN} ${SRC}/eaop.erl + +${EBIN}/eaopcore.beam: ${SRC}/eaopcore.erl + erlc -o ${EBIN} ${SRC}/eaopcore.erl + +${EBIN}/eaoputil.beam: ${SRC}/eaoputil.erl + erlc -o ${EBIN} ${SRC}/eaoputil.erl + +${EBIN}/eaopweaver.beam: ${SRC}/eaopweaver.erl + erlc -o ${EBIN} ${SRC}/eaopweaver.erl +clean: + rm -rf ${EBIN}/*.beam ${EBIN}/erl_crash.dump + rmdir ${EBIN} diff --git a/README.md b/README.md index ea24038..b36edfd 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,10 @@ eaop ==== -Compile time AOP implementation for Erlang +Compile time AOP implementation for Erlang. + +This project was inspired by [ErlAOP](http://sourceforge.net/projects/erlaop/), which was written by Alexei Krasnopolski. Most of the ErlAOP documentation is relevant to this project. + +eaop re-implements the functionality of ErlAOP using [erl_syntax](http://erlang.org/doc/man/erl_syntax.html) and should not be dependent on the abstract forms generated by the Erlang compiler. However, both ErlAOP and eaop are implemented using Erlang's [parse_transform/2](http://www.erlang.org/doc/man/erl_id_trans.html) mechanism, making both of them limited to compile time weaving of code. + +eaop also extends the expressiveness of pointcut definitions, allowing the specification of send and receive operations in Erlang code to be eligible points for code weaving. diff --git a/include/eaopglobals.hrl b/include/eaopglobals.hrl new file mode 100644 index 0000000..d60c0bb --- /dev/null +++ b/include/eaopglobals.hrl @@ -0,0 +1,8 @@ +%% The weaver module. +-define(WEAVER, eaopweaver). + +%% The core module. +-define(CORE, eaopcore). + +%% The utility module. +-define(UTIL, eaoputil). diff --git a/include/unit_testing.hrl b/include/unit_testing.hrl new file mode 100644 index 0000000..1a36125 --- /dev/null +++ b/include/unit_testing.hrl @@ -0,0 +1,6 @@ +%% Commenting NOTEST will remove tests when compiling. Keep this definition before the inclusion of eunit.hrl. +-define(NOTEST, true). + +-ifdef(EUNIT). +-include_lib("eunit/include/eunit.hrl"). +-endif. diff --git a/src/eaop.erl b/src/eaop.erl new file mode 100644 index 0000000..66f18f6 --- /dev/null +++ b/src/eaop.erl @@ -0,0 +1,129 @@ +%% +%% Copyright (C) 2013 by calleja.justin@gmail.com (Justin Calleja) +%% +%% 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. +%% + +%% Author: Justin Calleja +%% Description: This module is an interface to the user of eaop. Compilation is done through this module. +-module(eaop). + +-include("../include/eaopglobals.hrl"). +-include("../include/unit_testing.hrl"). + +%% +%% Exported Functions +%% +%% -export([]). +-compile(export_all). + +%% +%% API Functions +%% + +-spec compile(Srcs::[string()], Configs::[string()]) -> ok. +%% @todo Add the throws which can be thrown by functions executed within this function +%% ( e.g. {ambiguous_ptcut_type, [ptcut_t()]} ). +%% @doc +%% Srcs = list of directory names containing source files and/or file names. +%% Configs = list of directory names containing config files and/or config file names. +%% Compiles the source files (*.erl) explicitly listed or found in the directories listed in Srcs. +%% AOP weaving is done during the compilation stage using the configuration found in the config files +%% explicitly listed or found within the directories listed in Configs. The default file suffix to identify +%% a file as being a config file is .adf. +%% (Note: given any directory, all sub-directories are searched recursively for source/config files to use in +%% the compilation). +compile(Srcs, Configs) -> + compile(Srcs, Configs, []). + +-spec compile(Srcs::[string()], Configs::[string()], Options::[term()]) -> ok. +%% @throws TODO +%% @doc +%% Srcs = list of directory names containing source files and/or file names. +%% Configs = list of directory names containing config files and/or config file names. +%% Options = Options determine the behavior of the compiler as defined in compile:file/2. +%% Additional options include: +%% {config_suffix, Suffix}: used to change the default (.adf) suffix of aspect definition files for this compilation. +%% {print_gen_src, Dir}: this option prints the transformed source files after weaving in the directory Dir. +%% Same as eaop:compile/2 but takes a list of options. +compile([], _, _) -> + ok; +compile(Srcs, Configs, Options) -> + SrcFiles = get_files(Srcs, ".*\.erl$"), + Suffix = + case lists:keyfind(config_suffix, 1, Options) of + false -> + ".*\.adf$"; + {_, ConfigSuffix} -> + ".*\." ++ ConfigSuffix ++ "$" + end, + ConfigFiles = get_files(Configs, Suffix), + Aspects = read_aspects(ConfigFiles), + Opts = ?WEAVER:make_options(Aspects, Options), + compile_files(SrcFiles, Opts). + +%% @doc compile_aspects/2 can be used when you have the aspects themselves and don't need to process .adf files. If building the aspects programmatically, this is probably the function you'd want to use. +compile_aspects(Srcs, Aspects) -> + compile_aspects(Srcs, Aspects, []). + +%% @doc Similar to compile_aspects/2 but with options. +compile_aspects(Srcs, Aspects, Options) -> + SrcFiles = get_files(Srcs, ".*\.erl$"), + Weaver = get_weaver_module(Options), + Opts = Weaver:make_options(Aspects, Options), + compile_files(SrcFiles, Opts). + +get_weaver_module(Options) -> + proplists:get_value(weaver, Options, ?WEAVER). + +-type file_or_dir() :: filelib:filename() | filelib:dirname(). +-spec get_files([FileOrDirName::file_or_dir()], SuffixRegex::string()) -> [filelib:filename()]. +get_files(FilesAndOrDirs, Suffix) -> + lists:append( + [ case filelib:is_dir(FileOrDir) of + true -> + filelib:fold_files(FileOrDir, Suffix, true, fun(F, Acc) -> [F | Acc] end, []); + false -> + [FileOrDir] + end || FileOrDir <- FilesAndOrDirs ]). + +%% Note: the type compile_res() is actually whatever compile:file/2 is capable of returning. +-type compile_res() :: {ok, module()} | {ok, module(), Warnings::[term()]} | {ok, module(), binary()} | {ok, module(), binary(), Warnings::[term()]} | {error, Errors::[term()], Warnings::[term()]} | error. +-spec compile_files(SrcFiles::[file:name()], Options::[?WEAVER:eaop_compile_opt()]) -> [{SrcFile::file:name(), CompileResult::compile_res()}]. +compile_files(SrcFiles, Options) -> + lists:foldl( + fun(S, Results) -> + CompileRes = compile:file(S, Options), + [{S, CompileRes} | Results] + end, [], SrcFiles). + + +%% +%% Local Functions +%% + +-spec read_aspects(ConfigFiles::[file:name()]) -> [?CORE:aspect()]. +read_aspects(ConfigFiles) -> + ?CORE:prepare_aspects_for_weaving(read_globals(ConfigFiles)). + +-spec read_globals(ConfigFiles::[file:name()]) -> ?CORE:globals(). +read_globals(ConfigFiles) -> + ?CORE:get_globals(read_configs(ConfigFiles)). + +-spec read_configs([file:name()]) -> [?CORE:aop_el()]. +read_configs(Files) -> + lists:foldl( + fun(File, Adfs) -> + {ok, Adf} = file:consult(File), + lists:append(Adfs, Adf) + end, [], Files). diff --git a/src/eaopcore.erl b/src/eaopcore.erl new file mode 100644 index 0000000..0130b97 --- /dev/null +++ b/src/eaopcore.erl @@ -0,0 +1,701 @@ +%% +%% Copyright (C) 2013 by calleja.justin@gmail.com (Justin Calleja) +%% +%% 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. +%% + +%% Author: Justin Calleja +%% Description: All other modules are meant to use this module for access/creation/manipulation of the +%% data structures used in this project. + +-module(eaopcore). + +%% -export([get_globals/1, prepare_aspects_for_weaving/1, is_instrumentable_fun/1, exists_send_ptcut/1]). + +-compile(export_all). + +-include("../include/eaopglobals.hrl"). +-include("../include/unit_testing.hrl"). + +-define(casetf(Expr, True, False), case Expr of true -> True; false -> False end). + +-export_type([aop_el/0, aspect/0, globals/0]). +-export_type([advice_t/0]). + +-record(id, {val :: string()}). +-record(mf, {m :: atom(), f :: atom()}). +-record(send_msg, {msg :: string()}). +-record(receive_msg, {msg :: string()}). +-record(functiondef, { + m :: string() | atom(), f :: string() | atom(), a :: string() | integer() +}). +-record(args, { + exp :: string(), condition :: str_undef() +}). +-record(within, {scope :: scope()}). +-record(not_within, {scope :: scope()}). +-record(spawned, {scope :: scope()}). +-record(registered, {names :: [str_atom()]}). +-record(trap_exit, {val = false :: boolean()}). +-record(visibility, {val = global :: visibility()}). +-record(type, {val :: advice_t()}). +-record(ptcuts, {val :: [str_pointcut()]}). + +-record(aspect, {attribs = [] :: [aspect_attr()]}). +-record(advice, {attribs = [] :: [advice_attr()]}). +-record(pointcut, {attribs = [] :: [pointcut_attr()]}). + +-record(globals, { + aspects = [] :: [aspect()], + advices = [] :: [advice()], + pointcuts = [] :: [pointcut()] +}). + +-type advice_t() :: before | 'after' | after_throw | after_final | around. + +-type str_atom() :: string() | atom(). +-type str_byte() :: string() | byte(). +-type str_undef() :: string() | undefined. +-type scope() :: [{Module::str_atom(), Function::str_atom(), Arity::str_byte()}]. +-type visibility() :: local | public | global. +-type str_pointcut() :: string() | pointcut(). +%% -type mf() :: #mf{}. + +-type aspect_attr() :: + #id{} | + advice() | + pointcut(). + +-type advice_attr() :: + #id{} | + #type{} | + #mf{} | + #ptcuts{}. + +%% Note: the following are mutually exclusive: call, send_msg, or receive_msg. They determine the pointcut's type. +%% Note: within, not_within, spawned, registered, trap_exit, and visibility are not yet implemented. They may be used but they will be ignored. +-type pointcut_attr() :: + #id{} | %% The id is used to refer to the pointcut. + #send_msg{} | %% Defines which sent messages to advice. + #receive_msg{} | %% Defines which received messages to advice. + #functiondef{} | %% Defines which function definitions to advise + #args{} | %% Defines the format in which the argument/s of the functiondef/send/recieve need to + %% be in in order for the advice to take place. Optionally, a condition may be + %% specified over the variables defined in the format. + #within{} | %% Defines the scope within which this pointcut applies. Any join points outside + %% of the defined scope which match this pointcut will be ignored. + #not_within{} | %% Defines the scope within which this pointcut is not allowed to apply. + %% Any join points inside the defined scope which match this pointcut will be ignored. + #spawned{} | %% Defines a set of functions. Assuming a join point matches this pointcut, + %% the join point will not be adviced unless the process executing the join point + %% was spawned by one of the functions defined in this set. + #registered{} | %% Defines a set of registered names. Assuming a join point matches this pointcut, + %% the join point will not be adviced unless the process executing the join point is + %% registered under a name in this set. + #trap_exit{} | %% Requires the process executing the join point to be a system process. + %% Assuming a join point matches this pointcut, the join point will not be + %% adviced unless the process executing the join point is trapping exits. + #visibility{}. %% Only applicable to functiondef pointcuts. Determines whether the functiondef being selected must be + %% local to the module, exported from the module (public), or it can be both (global). + +-opaque aspect() :: #aspect{}. +-opaque advice() :: #advice{}. +-opaque pointcut() :: #pointcut{}. + +-opaque aop_el() :: aspect() | advice() | pointcut(). +-opaque aop_attr() :: aspect_attr() | advice_attr() | pointcut_attr(). + +-opaque globals() :: #globals{}. + +%% +%% Exported functions: +%% + +get_advice_module(Advice) when is_record(Advice, advice) -> + Fun = fun_advice_attrib_selector(mf), + case Fun(Advice) of + no_attr -> + undefined; + MFAttr -> + MFAttr#mf.m + end. + +get_advice_function(Advice) when is_record(Advice, advice) -> + Fun = fun_advice_attrib_selector(mf), + case Fun(Advice) of + no_attr -> + undefined; + MFAttr -> + MFAttr#mf.f + end. + +-spec get_applicable_advices(StrModuleName::string(), StrFunctionName::string(), Arity::integer(), Aspects::[aspect()]) -> ApplicableAdvices::[advice()]. +%% @doc Returns the advices in Aspects which are applicable to the function with name StrFunctionName, in the module with name StrModuleName, with an arity of Arity. +%% Applicability is determined by the functiondef attribute in pointcuts. +get_applicable_advices(StrModuleName, StrFunctionName, Arity, Aspects) -> + FdAdvicePointcut = foldl_pointcuts(fun fd_advice_pointcut/4, Aspects), + lists:foldl( + fun({FdAdvice, FdPointcut}, ApplicableAdvicesAcc) -> + case mfa_satisfies_fdpointcut(StrModuleName, StrFunctionName, Arity, FdPointcut) of + true -> + [FdAdvice | ApplicableAdvicesAcc]; + false -> + ApplicableAdvicesAcc + end + end, [], FdAdvicePointcut). + +get_advices_by_type(Advices, Type) -> + Fun = fun_advice_attrib_selector(type), + lists:foldl( + fun(Advice, SameTypeAdvicesAcc) -> + case Fun(Advice) of + no_attr -> + SameTypeAdvicesAcc; + TypeAttr -> + case TypeAttr#type.val == Type of + true -> + [Advice | SameTypeAdvicesAcc]; + false -> + SameTypeAdvicesAcc + end + end + end, [], Advices). + +-spec fd_advice_pointcut(aspect(), advice(), pointcut(), [{advice(), pointcut()}]) -> [{advice(), pointcut()}]. +%% @doc This function is passed to foldl_pointcuts/2. If Pointcut is of type functiondef, {Advice, Pointcut} is appended to the accumulator PointcutAcc. Otherwise the accumulator is returned. +fd_advice_pointcut(_Aspect, Advice, Pointcut, PointcutAcc) -> + Fun = fun_pointcut_attrib_selector(functiondef), + case Fun(Pointcut) of + no_attr -> + PointcutAcc; + _FunctiondefAttr -> + [{Advice, Pointcut} | PointcutAcc] + end. + +mfa_satisfies_fdpointcut(StrModuleName, StrFunctionName, Arity, FdPointcut) -> + Fun = fun_pointcut_attrib_selector(functiondef), + FdAttr = Fun(FdPointcut), + case m_satisfies_fdpointcut(StrModuleName, FdAttr#functiondef.m) of + true -> + case f_satisfies_fdpointcut(StrFunctionName, FdAttr#functiondef.f) of + true -> + a_satisfies_fdpointcut(Arity, FdAttr#functiondef.a); + false -> + false + end; + false -> + false + end. + +m_satisfies_fdpointcut(StrModuleName, FdModule) when is_atom(FdModule) -> + list_to_atom(StrModuleName) == FdModule; +m_satisfies_fdpointcut(StrModuleName, FdModule) when is_list(FdModule) -> + match(StrModuleName, FdModule). + +f_satisfies_fdpointcut(StrFunctionName, FdFunction) when is_atom(FdFunction) -> + list_to_atom(StrFunctionName) == FdFunction; +f_satisfies_fdpointcut(StrFunctionName, FdFunction) when is_list(FdFunction) -> + match(StrFunctionName, FdFunction). + +-spec a_satisfies_fdpointcut(Arity::integer(), FdArity::integer()) -> boolean(); + (integer(), string()) -> boolean(). +%% @doc When FdArity is a string(), it is assumed that it is a regex +a_satisfies_fdpointcut(Arity, FdArity) when is_integer(FdArity) -> + Arity == FdArity; +a_satisfies_fdpointcut(Arity, FdArity) when is_list(FdArity) -> + match(integer_to_list(Arity), FdArity). + +match(Str, Regex) -> + {ok, Pattern} = re:compile(Regex), + Options = [notempty,{capture,none}], + re:run(Str, Pattern, Options) == match. + +%% @doc Applies Fun to every pointcut within every advice within every aspect in the given Aspects. +foldl_pointcuts(Fun, Aspects) -> + Result = lists:foldl( + fun(Aspect, AspectAcc) -> + Advices = aadvice(Aspect), + FoldlOverAdvices = lists:foldl( + fun(Advice, AdviceAcc) -> + Pointcuts = advpointcuts(Advice), + FoldlOverPointcuts = lists:foldl( + fun(Pointcut, PointcutAcc) -> + Fun(Aspect, Advice, Pointcut, PointcutAcc) + end, [], Pointcuts), + [FoldlOverPointcuts | AdviceAcc] + end, [], Advices), + [FoldlOverAdvices | AspectAcc] + end, [], Aspects), + lists:flatten(Result). + + +is_aspect(Aspect) -> is_record(Aspect, aspect). + +is_advice(Advice) -> is_record(Advice, advice). + +is_pointcut(Pointcut) -> is_record(Pointcut, pointcut). + +is_aspect_attrib(Attrib) when not is_tuple(Attrib) -> false; +is_aspect_attrib(Attrib) -> lists:member(element(1, Attrib), [id, advice, pointcut]). + +is_advice_attrib(Attrib) when not is_tuple(Attrib) -> false; +is_advice_attrib(Attrib) -> lists:member(element(1, Attrib), [id, type, mf, ptcuts]). + +is_pointcut_attrib(Attrib) when not is_tuple(Attrib) -> false; +is_pointcut_attrib(Attrib) -> lists:member(element(1, Attrib), [id, send_msg, receive_msg, functiondef, args, within, not_within, spawned, registered, trap_exit, visibility]). + +-spec add(AopEl::aop_el(), Attrib::aop_attr()) -> aop_el(); + (AopEl::aop_el(), Attribs::[aop_attr()]) -> aop_el(). +%% @doc Adds Attrib to AopEl if the Attrib is a valid attribute of AopEl, and returns the new aop_el(). +%% Returns AopEl otherwise. Can also handle a list of aop_attr(). In this case, the attributes are added +%% from left to right. +add(AopEl, []) -> + AopEl; +add(AopEl, [Attrib | Attribs]) -> + add(add(AopEl, Attrib), Attribs); +add(#aspect{attribs = AspectAttribs} = Aspect, AspectAttrib) -> + ?casetf(is_aspect_attrib(AspectAttrib), #aspect{attribs = [AspectAttrib | AspectAttribs]}, Aspect); +add(#advice{attribs = AdviceAttribs} = Advice, AdviceAttrib) -> + ?casetf(is_advice_attrib(AdviceAttrib), #advice{attribs = [AdviceAttrib | AdviceAttribs]}, Advice); +add(#pointcut{attribs = PointcutAttribs} = Pointcut, PointcutAttrib) -> + ?casetf(is_pointcut_attrib(PointcutAttrib), #pointcut{attribs = [PointcutAttrib | PointcutAttribs]}, Pointcut). + +-spec aspect() -> aspect(). +aspect() -> #aspect{}. + +-spec advice() -> advice(). +advice() -> #advice{}. + +-spec pointcut() -> pointcut(). +pointcut() -> #pointcut{}. + +aspect(Attribs) when is_list(Attribs) -> + ?casetf(lists:all(fun is_aspect_attrib/1, Attribs), #aspect{attribs = Attribs}, invalid). + +advice(Attribs) when is_list(Attribs) -> + ?casetf(lists:all(fun is_advice_attrib/1, Attribs), #advice{attribs = Attribs}, invalid). + +pointcut(Attribs) when is_list(Attribs) -> + ?casetf(lists:all(fun is_pointcut_attrib/1, Attribs), #pointcut{attribs = Attribs}, invalid). + +id(Id) when is_atom(Id) -> #id{val = atom_to_list(Id)}; +id(Id) when is_integer(Id) -> #id{val = integer_to_list(Id)}; +id(Id) -> #id{val = Id}. + +mf(Module, Function) -> #mf{m = Module, f = Function}. + +send_msg(Msg) -> #send_msg{msg = Msg}. + +receive_msg(Msg) -> #receive_msg{msg = Msg}. + +%% call(Module, Function, Arity) -> #call{m = Module, f = Function, a = Arity}. + +functiondef(Module, Function, Arity) -> #functiondef{m = Module, f = Function, a = Arity}. + +args(Exp, Condition) -> #args{exp = Exp, condition = Condition}. + +within(Scope) -> #within{scope = Scope}. + +not_within(Scope) -> #not_within{scope = Scope}. + +spawned(Scope) -> #spawned{scope = Scope}. + +registered(Names) -> #registered{names = Names}. + +trap_exit(Bool) -> #trap_exit{val = Bool}. + +visibility(Visibility) -> #visibility{val = Visibility}. + +type(Type) -> #type{val = Type}. + +ptcuts(Ptcuts) -> #ptcuts{val = Ptcuts}. + +%% -spec is_instrumentable_fun(Aspect::aspect()) -> fun((Form::erl_parse:abstract_form()) -> boolean()). +%% %% @doc Returns a function which when applied to an abstract_form() determines whether that form needs to be +%% %% instrumented. This decision is taken according to the information encapsulated within the given Aspect. +%% is_instrumentable_fun(Aspect = #aspect{attribs = AspectAttribs}) -> +%% fun({function, _LineNum, FunName, Arity, Clauses}) -> +%% todo; +%% (SendForm = {op, _LineNum, '!', Pid, Msg}) -> +%% %% Get all send_msg attribs in all pointcuts within all advices of given Aspect. +%% %% These send_msg attribs have a value - a string() encoding the format in which a message must be in order for it to be instrumented. +%% %% Pass these values to SRMATCHER and if the matcher returns true at least once, then SendForm needs to be instrumented. +%% Advices = aadvice(AspectAttribs), +%% FunAttribSelector = fun_pointcut_attrib_selector(send_msg), +%% SendMsgAttribs = apply_attr_selector(FunAttribSelector, Advices), +%% lists:any( +%% fun(#send_msg{msg = SendMsg}) -> +%% ?SRMATCHER:send_matcher(Msg, SendMsg, [srmatcher:send_form(SendForm)]) +%% end, SendMsgAttribs); +%% (ReceiveForm = {'receive', _LineNum, _Clauses}) -> +%% todo; +%% (_Form) -> +%% false +%% end. + +exists_send_ptcut(#aspect{attribs = AspectAttribs}) -> + lists:any(fun(Advice) -> exists_ptcut_attr(Advice, send_msg) end, aadvice(AspectAttribs)); +exists_send_ptcut(Advice) when is_record(Advice, advice) -> + exists_ptcut_attr(Advice, send_msg). + +exists_receive_ptcut(#aspect{attribs = AspectAttribs}) -> + lists:any(fun(Advice) -> exists_ptcut_attr(Advice, receive_msg) end, aadvice(AspectAttribs)); +exists_receive_ptcut(Advice) when is_record(Advice, advice) -> + exists_ptcut_attr(Advice, receive_msg). + +exists_functiondef_ptcut(#aspect{attribs = AspectAttribs}) -> + lists:any(fun(Advice) -> exists_ptcut_attr(Advice, functiondef) end, aadvice(AspectAttribs)); +exists_functiondef_ptcut(Advice) when is_record(Advice, advice) -> + exists_ptcut_attr(Advice, functiondef). + +-spec exists_ptcut_attr(Aspect::aspect(), Attr::atom()) -> boolean(); + (Advice::advice(), Attr::atom()) -> boolean(). +%% @doc Returns 'true' when at least one advice in the given Aspect has a pointcut which contains an attribute of type Attr. +%% Returns 'true' if the given Advice has a pointcut which contains an attribute of type Attr. Returns 'false' otherwise. +exists_ptcut_attr(#aspect{attribs = AspectAttribs}, Attr) -> + lists:any(fun(Advice) -> exists_ptcut_attr(Advice, Attr) end, aadvice(AspectAttribs)); +exists_ptcut_attr(#advice{attribs = AdviceAttribs}, Attr) -> + Fun_PtcutAttribSelector = fun_pointcut_attrib_selector(Attr), + Pointcuts = advpointcuts(AdviceAttribs), + Pred = + fun(Pointcut) -> + case Fun_PtcutAttribSelector(Pointcut) of + no_attr -> false; + _ -> true + end + end, + lists:any(Pred, Pointcuts). + +-spec remove_non_pointcuts(List::[term()]) -> [pointcut()]. +%% @doc Removes anything which is not a pointcut() in the given List and returns the result. +remove_non_pointcuts(StrPointcuts) -> + lists:filter( + fun(StrPointcut) -> is_record(StrPointcut, pointcut) end, + StrPointcuts). + +-spec get_globals([aop_el()]) -> globals(). +get_globals(AopEls) -> + get_globals(AopEls, #globals{}). + + +-spec prepare_aspects_for_weaving(globals()) -> [aspect()]. +prepare_aspects_for_weaving(Globals) -> + [prepare_aspect_for_weaving(Aspect, Globals) || Aspect <- gaspects(Globals)]. + +%% +%% Not sure whether to export or make local: +%% + +-spec gaspects(globals()) -> [aspect()]. +gaspects(#globals{aspects = Aspects}) -> + Aspects. + +-spec gadvices(globals()) -> [advice()]. +gadvices(#globals{advices = Advices}) -> + Advices. + +-spec gpointcuts(globals()) -> [pointcut()]. +gpointcuts(#globals{pointcuts = Pointcuts}) -> + Pointcuts. + +-spec apointcuts(aspect()) -> [pointcut()]; + ([aspect_attr()]) -> [pointcut()]. +apointcuts(#aspect{attribs = AspectAttribs}) -> + apointcuts(AspectAttribs); +apointcuts(AspectAttribs) -> + [P || P <- AspectAttribs, is_record(P, pointcut)]. + +-spec aadvice(aspect()) -> [advice()]; + ([aspect_attr()]) -> [advice()]. +aadvice(#aspect{attribs = AspectAttribs}) -> + aadvice(AspectAttribs); +aadvice(AspectAttribs) -> + [Adv || Adv <- AspectAttribs, is_record(Adv, advice)]. + +-spec advpointcuts_with_refs(advice()) -> [str_pointcut()]; + ([advice_attr()]) -> [str_pointcut()]. +%% @doc Extracts the value of the ptcuts attribute in the given advice. +advpointcuts_with_refs(#advice{attribs = AdviceAttribs}) -> + advpointcuts_with_refs(AdviceAttribs); +advpointcuts_with_refs(AdviceAttribs) -> + case lists:keyfind(ptcuts, 1, AdviceAttribs) of + #ptcuts{val = PtcutsValue} -> + PtcutsValue; + false -> + [] + end. + +-spec advpointcuts(advice()) -> [pointcut()]; + ([advice_attr()]) -> [pointcut()]. +%% @doc Extracts the value of the ptcuts attribute in the given advice. +advpointcuts(Advice) -> + remove_non_pointcuts(advpointcuts_with_refs(Advice)). + +-spec fun_pointcut_attrib_selector(Attrib::atom()) -> fun((Pointcut::pointcut()) -> pointcut_attr() | no_attr). +%% @doc Returns a function which takes a Pointcut as an argument and returns a pointcut_attr() or no_attr. +%% pointcut_attr() is returned if the given Pointcut contains an attribute with key Attrib. no_attr is returned +%% if Pointcut does not contain an attribute with key Attrib. +fun_pointcut_attrib_selector(AttribName) -> + fun(#pointcut{attribs = PointcutAttribs}) -> + case lists:keyfind(AttribName, 1, PointcutAttribs) of + false -> + no_attr; + Attrib -> + Attrib + end + end. + +fun_advice_attrib_selector(AttribName) -> + fun(#advice{attribs = AdviceAttribs}) -> + case lists:keyfind(AttribName, 1, AdviceAttribs) of + false -> + no_attr; + Attrib -> + Attrib + end + end. + +%% get_send_msg/1 and get_receive_msg/1 can probably be deleted later. Their use is suppose to have been substituted by get_msg_format/1. +-spec get_send_msg(Pointcut::pointcut()) -> string() | undefined. +%% @doc Returns the given Pointcut's send_msg format string or 'undefined' if the Pointcut does not have the send_msg attribute. +get_send_msg(Pointcut) when is_record(Pointcut, pointcut) -> + Selector = fun_pointcut_attrib_selector(send_msg), + case Selector(Pointcut) of + no_attr -> + undefined; + SendMsg -> + SendMsg#send_msg.msg + end. + +-spec get_msg_format(Pointcut::pointcut()) -> string() | undefined. +%% @doc Returns the message format of the given Pointcut's first occurrence of send_msg or receive_msg or undefined if Pointcut does not contain neither a send_msg attribute nor a receive_msg attribute. +get_msg_format(#pointcut{attribs = PointcutAttribs} = Pointcut) when is_record(Pointcut, pointcut) -> + case ?UTIL:find_first(fun(Attrib) -> is_record(Attrib, send_msg) orelse is_record(Attrib, receive_msg) end, PointcutAttribs) of + undefined -> + undefined; + FoundAttrib when is_record(FoundAttrib, send_msg) -> + FoundAttrib#send_msg.msg; + FoundAttrib when is_record(FoundAttrib, receive_msg) -> + FoundAttrib#receive_msg.msg + end. + +-spec get_type(Advice::advice()) -> advice_t() | undefined. +get_type(Advice) when is_record(Advice, advice) -> + Selector = fun_advice_attrib_selector(type), + case Selector(Advice) of + no_attr -> + undefined; + Type -> + Type#type.val + end. + +-spec get_mf(Advice::advice()) -> {Module::atom(), Function::atom()} | undefined. +get_mf(Advice) when is_record(Advice, advice) -> + Selector = fun_advice_attrib_selector(mf), + case Selector(Advice) of + no_attr -> + undefined; + Mf -> + {Mf#mf.m, Mf#mf.f} + end. + +%% +%% Local functions: +%% + +%% fun((Elem::T) -> boolean()), + +%% apply_attr_selector + +-spec to_remove_apply_attr_selector(AttrSelector::fun((pointcut()) -> pointcut_attr() | no_attr), Advices::[advice()]) -> [pointcut_attr()]. +%% @doc Applies AttrSelector to each pointcut within each advice of the given Advices and returns a list containing +%% the result of each application of AttrSelector when such a result is not the atom 'no_attr'. +to_remove_apply_attr_selector(Fun, Advices) -> + DirtyPointcutAttribs = + [hd(hd([[Fun(Pointcut) || Pointcut <- Pointcuts, is_record(Pointcut, pointcut)] || Pointcuts <- advpointcuts(Advice)])) + || Advice <- Advices], + lists:filter(fun(PointcutAttrib) -> PointcutAttrib =/= no_attr end, DirtyPointcutAttribs). + +-spec get_globals([aop_el()], globals()) -> globals(). +get_globals([], Globals) -> + Globals; +get_globals([GAspect | AopEls], Globals) when is_record(GAspect, aspect) -> + get_globals(AopEls, Globals#globals{aspects = lists:append(gaspects(Globals), [GAspect])}); +get_globals([GAdvice | AopEls], Globals) when is_record(GAdvice, advice) -> + get_globals(AopEls, Globals#globals{advices = lists:append(gadvices(Globals), [GAdvice])}); +get_globals([GPointcut | AopEls], Globals) when is_record(GPointcut, pointcut) -> + get_globals(AopEls, Globals#globals{pointcuts = lists:append(gpointcuts(Globals), [GPointcut])}). + +-spec prepare_aspect_for_weaving(aspect(), globals()) -> aspect(). +%% @doc Preparing an aspect for weaving involves carrying out two operations on an aspect. +%%
    +%%
  1. Importing global configuration of local pointcuts and advices - the pointcut/advice import stage.
    2. +%%
  2. Resolving the local/global pointcuts to which local advices refer to by id - the pointcut resolution stage.
    3. +%%
+%% @throws {unresolvable_ptcut, string()} +prepare_aspect_for_weaving(Aspect, Globals) -> + AspectAttribsWithImports = + lists:map( + fun(Advice) when is_record(Advice, advice) -> + import_global_conf(Advice, Globals); + (Pointcut) when is_record(Pointcut, pointcut) -> + import_global_conf(Pointcut, Globals); + (AspectAttrib) -> + AspectAttrib + end, + get_attribs(Aspect)), + PreparedAspectAttribs = + lists:map( + fun(Advice) when is_record(Advice, advice) -> + resolve_advice_ref_to_pointcut(Advice, #aspect{attribs = AspectAttribsWithImports}, Globals); + (AspectAttrib) -> + AspectAttrib + end, + AspectAttribsWithImports), + #aspect{attribs = PreparedAspectAttribs}. + +-spec import_global_conf(advice(), globals()) -> advice(); + (pointcut(), globals()) -> pointcut(). +%% @doc Advice and pointcut attributes in an aspect are eligible for importing global configuration. +%% This means that if the advice or pointcut in question has an id attribute, the following algorithm +%% takes place (the same applies for pointcut attributes): +%% +import_global_conf(Advice = #advice{attribs = AdviceAttribs}, Globals) -> + case get_id(AdviceAttribs) of + undefined -> + Advice; + Id -> + case ?UTIL:find_first(fun(GlobalAdvice) -> get_id(GlobalAdvice) =:= Id end, gadvices(Globals)) of + undefined -> + Advice; + GAdviceSameId -> + #advice{attribs = overwrite_attribs(AdviceAttribs, get_attribs(GAdviceSameId))} + end + end; +import_global_conf(Pointcut = #pointcut{attribs = PointcutAttribs}, Globals) -> + case get_id(PointcutAttribs) of + undefined -> + Pointcut; + Id -> + case ?UTIL:find_first(fun(GlobalPointcut) -> get_id(GlobalPointcut) =:= Id end, gpointcuts(Globals)) of + undefined -> + Pointcut; + GPointcutSameId -> + #pointcut{attribs = overwrite_attribs(PointcutAttribs, get_attribs(GPointcutSameId))} + end + end. + +-spec overwrite_attribs([aop_attr()], [aop_attr()]) -> [aop_attr()]. +%% @spec overwrite_attribs(PriorityAttribs::[aop_attr()], Attribs::[aop_attr()]) -> [aop_attr()] +%% @doc The attributes of PriorityAttribs and Attribs are merged into one [aop_attr()] with the condition that +%% no attributes in Attribs are included in the resulting [aop_attr()] if their key matches a key already present in +%% any attribute from PriorityAttribs. +overwrite_attribs(PriorityAttribs, Attribs) -> + lists:append(PriorityAttribs, + lists:filter( + fun(Attr) -> + not lists:keymember(element(1, Attr), 1, PriorityAttribs) + end , Attribs)). + +-spec resolve_advice_ref_to_pointcut(advice(), aspect(), globals()) -> advice(). +%% @doc Local/global pointcut resolution by id involves: +%% +%% @throws {advice_has_no_ptcuts, AdviceId::str_undef()} | +%% {unresolvable_ptcut_ref, {advice, AdviceId::str_undef()}, {pointcut_id, PointcutId::string()}} | +%% {non_pointcut_value_in, Pointcuts::list()} + resolve_advice_ref_to_pointcut(Advice = #advice{attribs = AdviceAttribs}, Aspect, Globals) -> + PtcutsRefOrDef = get_pointcuts_ref_or_def(AdviceAttribs), + LocalPointcuts = apointcuts(Aspect), + GlobalPointcuts = gpointcuts(Globals), + ResolvedPointcuts = + lists:map( + fun(Pointcut) when is_record(Pointcut, pointcut) -> + Pointcut; + (PointcutIdRef) -> + Pred = fun(Pointcut) -> get_id(Pointcut) =:= PointcutIdRef end, + case ?UTIL:find_first(Pred, LocalPointcuts) of + undefined -> + case ?UTIL:find_first(Pred, GlobalPointcuts) of + undefined -> + erlang:throw({unresolvable_ptcut_ref, {advice, get_id(Advice)}, {pointcut_id, PointcutIdRef}}); + ResolvedGlobalPointcut -> + ResolvedGlobalPointcut + end; + ResolvedLocalPointcut -> + ResolvedLocalPointcut + end + end, PtcutsRefOrDef), + replace_ptcuts(ResolvedPointcuts, Advice). + +-spec replace_ptcuts(Pointcuts::[pointcut()], Advice::advice()) -> advice(). +%% @doc Replaces the given Advice's ptcuts attribute with one which has Pointcuts for its value. +%% It is assumed that the given Pointcuts list is a list of pointcut(), i.e. no references to pointcut ids should +%% be present in Pointcuts, only pointcut() values. If a value in Pointcuts is not a pointcut(), an exception is thrown. +%% @throws {non_pointcut_value_in, Pointcuts::list()} +replace_ptcuts(Pointcuts, Advice = #advice{attribs = AdviceAttribs}) -> + ?casetf(lists:all(fun(Pointcut) -> is_record(Pointcut, pointcut) end, Pointcuts), ok, erlang:throw({non_pointcut_value_in, Pointcuts})), + NewAdviceAttribs = lists:keyreplace(ptcuts, 1, AdviceAttribs, #ptcuts{val = Pointcuts}), + Advice#advice{attribs=NewAdviceAttribs}. + +-spec get_pointcuts_ref_or_def(advice()) -> [advice_attr()]; + ([advice_attr()]) -> [advice_attr()]. +%% @doc Returns the list of point cut id references and actual pointcuts (i.e. the value of the advice attribute, #ptcuts{}) +%% within the given advice() or [advice_attr()]. Throws an exception if the #ptcuts{} attribute cannot be found or +%% it's value is an empty list. +%% @throws {advice_has_no_ptcuts, AdviceId::str_undef()} +get_pointcuts_ref_or_def(#advice{attribs = AdviceAttribs}) -> + get_pointcuts_ref_or_def(AdviceAttribs); +get_pointcuts_ref_or_def(AdviceAttribs) -> + case lists:keyfind(ptcuts, 1, AdviceAttribs) of + false -> + erlang:throw({advice_has_no_ptcuts, get_id(AdviceAttribs)}); + #ptcuts{val = []} -> + erlang:throw({advice_has_no_ptcuts, get_id(AdviceAttribs)}); + #ptcuts{val = PtcutsValue} -> + PtcutsValue + end. + +-spec get_id(aop_el()) -> string() | undefined + ; ([aop_attr()]) -> string() | undefined. +get_id(AopEl) when is_record(AopEl, aspect) orelse is_record(AopEl, advice) orelse is_record(AopEl, pointcut) -> + get_id(get_attribs(AopEl)); +get_id(AopAttribs) -> + proplists:get_value(id, AopAttribs). + +-spec get_attribs(aop_el()) -> [aop_attr()]. +get_attribs(AopEl) -> + element(2, AopEl). + diff --git a/src/eaoputil.erl b/src/eaoputil.erl new file mode 100644 index 0000000..4d7f03d --- /dev/null +++ b/src/eaoputil.erl @@ -0,0 +1,58 @@ +%% +%% Copyright (C) 2013 by calleja.justin@gmail.com (Justin Calleja) +%% +%% 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. +%% + +%% Author: Justin Calleja +%% Description: Utilitly functions. + +-module(eaoputil). + +-export([find_first/2, filter_out/2, forms_to_binary/1]). + +-include("../include/unit_testing.hrl"). + +%% +%% API functions: +%% + +-spec find_first(Pred::fun((Elem::T) -> boolean()), List::[T]) -> T | undefined. +%% @doc Given a predicate function Pred, this function iterates (head-to-tail) through List of type T, applying +%% each element in List to Pred. The first element in List to satisfy Pred is returned by the function and no more +%% processing is done by the function. undefined is returned if all the elements in List do not satisfy Pred. +find_first(_, []) -> + undefined; +find_first(Pred, [Head | Tail]) -> + case Pred(Head) of + true -> + Head; + false -> + find_first(Pred, Tail) + end. + +-spec filter_out(T::term(), List::list()) -> list(). +%% @doc Removes any elements in List which are exactly equal to T. +filter_out(Term, List) -> + lists:filter( + fun(El) -> + El =/= Term + end, List). + +-spec forms_to_binary([erl_parse:abstract_form()]) -> binary(); + (erl_parse:abstract_form()) -> binary(). +forms_to_binary(Forms) when is_list(Forms) -> + list_to_binary(lists:flatten([erl_pp:form(Form) || Form <- Forms])); +forms_to_binary(Form) -> + forms_to_binary([Form]). + diff --git a/src/eaopweaver.erl b/src/eaopweaver.erl new file mode 100644 index 0000000..0be6d2b --- /dev/null +++ b/src/eaopweaver.erl @@ -0,0 +1,623 @@ +%% +%% Copyright (C) 2013 by calleja.justin@gmail.com (Justin Calleja) +%% +%% 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. +%% + +%% Author: Justin Calleja +%% Description: TODO: Add description to eaopweaver + +-module(eaopweaver). +%% -export([make_options/2]). +-compile(export_all). + +-include("../include/eaopglobals.hrl"). +-include("../include/unit_testing.hrl"). + +-export_type([eaop_compile_opt/0]). + +-define(ASPECTS_KEY, aspects). +-define(ES, erl_syntax). +-define(SUFFIX, "@EAOP"). +-define(TARGET_SUFFIX, "@EAOP_target"). + +-type eaop_compile_opt() :: compile:option() | {?ASPECTS_KEY, [?CORE:aspect()]}. + +parse_transform(Forms, Options) -> + Aspects = get_aspects_from_options(Options), + SendPtcutExists = lists:any(fun ?CORE:exists_send_ptcut/1, Aspects), + ReceivePtcutExists = lists:any(fun ?CORE:exists_receive_ptcut/1, Aspects), + FunctiondefPtcutExists = lists:any(fun ?CORE:exists_functiondef_ptcut/1, Aspects), + TransFun = create_trans_fun(SendPtcutExists, ReceivePtcutExists, FunctiondefPtcutExists, Aspects), + {Module, NewForms} = transform(Forms, TransFun), + case print_gen_src(Options) of + {true, Path} -> + Filename = Module ++ ".erl", + file:write_file(filename:join([Path, Filename]), ?UTIL:forms_to_binary(NewForms)); + _ -> + ok + end, + NewForms. + +-spec transform(Forms::[erl_parse:abstract_form()], F::fun((?ES:syntaxTree(), pid()) -> ?ES:syntaxTree())) -> {Module::atom(), [erl_parse:abstract_form()]}. +transform(Forms, F) -> + Tree = ?ES:form_list(Forms), + Pid = start_weaver_notes(), + ModifiedTree = postorder(F, Tree, Pid), + Module = ?ES:atom_literal(get_current_module(Pid)), + stop_weaver_notes(Pid), + {Module, ?ES:revert_forms(ModifiedTree)}. + +postorder(F, Tree, WeaverNotesPid) -> + case get_current_mod_name(Tree) of + undefined -> + ok; + CurrentModName -> + set_current_module(WeaverNotesPid, CurrentModName) + end, + case get_current_fun_name(Tree) of + undefined -> + ok; + CurrentFunName -> + set_current_function(WeaverNotesPid, CurrentFunName), + Arity = ?ES:function_arity(Tree), + set_current_function_arity(WeaverNotesPid, Arity) + end, + SubTrees = + case ?ES:subtrees(Tree) of + [] -> + Tree; + List -> + ?ES:update_tree(Tree, [[postorder(F, Subtree, WeaverNotesPid) || Subtree <- Group] || Group <- List]) + end, + F(SubTrees, WeaverNotesPid). + +-spec get_current_mod_name(?ES:syntaxTree()) -> ?ES:syntaxTree() | undefined. +get_current_mod_name(Tree) -> + case ?ES:type(Tree) of + attribute -> + case ?ES:atom_value(?ES:attribute_name(Tree)) of + module -> + [TreeCurrentModName] = ?ES:attribute_arguments(Tree), + TreeCurrentModName; + _ -> + undefined + end; + _ -> + undefined + end. + +-spec get_current_fun_name(?ES:syntaxTree()) -> ?ES:syntaxTree() | undefined. +get_current_fun_name(Tree) -> + case ?ES:type(Tree) of + function -> + ?ES:function_name(Tree); + _ -> + undefined + end. + +print_gen_src(Options) -> + case proplists:get_value(print_gen_src, Options) of + undefined -> + undefined; + Path -> + {true, Path} + end. + +make_options(Aspects, Options) -> + lists:append([{parse_transform, ?MODULE}, return, report, {?ASPECTS_KEY, Aspects}], Options). + +-spec get_aspects_from_options([term()]) -> [?CORE:aspect()]. +%% @spec get_aspects_from_options([term()]) -> [aspect()] +%% @doc Retrieves the aspects from the given options. +get_aspects_from_options(Options) -> + proplists:get_value(?ASPECTS_KEY, Options, []). + +-record(adv_grps, { + before = [] :: [?CORE:advice()], + 'after' = [] :: [?CORE:advice()], + after_throw = [] :: [?CORE:advice()], + after_final = [] :: [?CORE:advice()], + around = [] :: [?CORE:advice()] +}). + +-spec group_advices([?CORE:advice()]) -> #adv_grps{}. +group_advices(Advices) -> + #adv_grps { + before = ?CORE:get_advices_by_type(Advices, before), + 'after' = ?CORE:get_advices_by_type(Advices, 'after'), + after_throw = ?CORE:get_advices_by_type(Advices, after_throw), + after_final = ?CORE:get_advices_by_type(Advices, after_final), + around = ?CORE:get_advices_by_type(Advices, around) + }. + +%% SendPtcutExists::boolean(), ReceivePtcutExists::boolean(), FunctiondefPtcutExists::boolean(), Aspects +%% @doc create_trans_fun/4 returns a function which will be used when transforming each Node in the abstract syntax tree. +create_trans_fun(SendPtcutExists, ReceivePtcutExists, FunctiondefPtcutExists, Aspects) -> + fun(Node, WeaverNotesPid) -> + NodeType = ?ES:type(Node), + if + SendPtcutExists == true andalso NodeType == infix_expr -> + case ?ES:operator_name(?ES:infix_expr_operator(Node)) == '!' of + true -> + transform_send(Node, WeaverNotesPid); + false -> + Node + end; + SendPtcutExists == true andalso NodeType == eof_marker andalso ReceivePtcutExists == false -> + ?ES:form_list([msg_info_function(send_msg_info_function_name(), Aspects), Node]); + SendPtcutExists == true andalso NodeType == eof_marker andalso ReceivePtcutExists == true -> + ?ES:form_list([msg_info_function(send_msg_info_function_name(), Aspects), msg_info_function(receive_msg_info_function_name(), Aspects), Node]); + ReceivePtcutExists == true andalso NodeType == receive_expr -> + transform_receive(Node, WeaverNotesPid); + ReceivePtcutExists == true andalso NodeType == eof_marker andalso SendPtcutExists == false -> + ?ES:form_list([msg_info_function(receive_msg_info_function_name(), Aspects), Node]); + FunctiondefPtcutExists == true andalso NodeType == function -> + TreeModuleName = get_current_module(WeaverNotesPid), + case get_applicable_advices(Node, TreeModuleName, Aspects) of + [] -> + Node; + ApplicableAdvices -> + AG = group_advices(ApplicableAdvices), + transform_functiondef(Node, TreeModuleName, AG) + end; + true -> + Node + end + end. + +-spec get_applicable_advices(TreeFunction::?ES:syntaxTree(), TreeModuleName::?ES:syntaxTree(), Aspects::[?CORE:aspect()]) -> Advices::[?CORE:advice()]. +get_applicable_advices(TreeFunction, TreeModuleName, Aspects) -> + StrModuleName = ?ES:atom_name(TreeModuleName), + StrFunctionName = ?ES:atom_name(?ES:function_name(TreeFunction)), + Arity = ?ES:function_arity(TreeFunction), + ?CORE:get_applicable_advices(StrModuleName, StrFunctionName, Arity, Aspects). + +-spec get_target_function_details_var() -> ?ES:syntaxTree(). +get_target_function_details_var() -> + ?ES:variable("TargetFunctionDetails"). + +%% TreeF is the original syntax tree node of type 'function' which is being transformed. +%% TreeTargetFName is a syntax tree of an atom with the name of the target function which the proxy function needs to call. +proxy_function(TreeF, TreeModuleName, TreeTargetFName, #adv_grps{before = BAdvs, 'after' = AftAdvs, after_throw = ATAdvs, after_final = AFAdvs, around = ArAdvs}) -> + Arity = ?ES:function_arity(TreeF), + TreeTargetFArgs = generate_vars(Arity), + TreeTargetFDetails = ?ES:list([TreeModuleName, TreeTargetFName, ?ES:list(TreeTargetFArgs)]), + TreeDetailsVar = get_target_function_details_var(), + TreeBindDetailsVar = ?ES:match_expr(TreeDetailsVar, TreeTargetFDetails), + TreeTargetFCall = ?ES:application(TreeTargetFName, TreeTargetFArgs), + BAdvCalls = before_advice_calls(BAdvs), + ArAndAftAdvCalls = around_and_after_advice_calls(ArAdvs, AftAdvs, TreeTargetFCall), + ProxyClauseBody = + if + ATAdvs == [] andalso AFAdvs == [] -> + [TreeBindDetailsVar | BAdvCalls] ++ ArAndAftAdvCalls; + true -> + CatchClauseList = after_throw_catch_clauses(ATAdvs), + AFAdvCalls = after_final_advice_calls(AFAdvs), + [TreeBindDetailsVar | BAdvCalls] ++ [?ES:try_expr(ArAndAftAdvCalls, [], CatchClauseList, AFAdvCalls)] + end, + ProxyClause = ?ES:clause(TreeTargetFArgs, [], ProxyClauseBody), + ?ES:function(?ES:function_name(TreeF), [ProxyClause]). + +-spec after_throw_catch_clauses([]) -> []; + (ATAdvs::[?CORE:advice()]) -> ClauseList::[?ES:syntaxTree()]. +after_throw_catch_clauses([]) -> + []; +after_throw_catch_clauses(ATAdvs) -> + TreeDetailsVar = get_target_function_details_var(), + TreeExClassVar = ?ES:variable("ExClass"), + TreeExPatternVar = ?ES:variable("ExPattern"), + %% TreeCatchClausePattern = ?ES:module_qualifier(TreeExClassVar, TreeExPatternVar), + TreeCatchClausePattern = ?ES:class_qualifier(TreeExClassVar, TreeExPatternVar), + TreeTuple = ?ES:tuple([TreeExClassVar, TreeExPatternVar]), + TreeCatchClauseBody = [?ES:application(?ES:atom(?CORE:get_advice_module(ATAdv)), ?ES:atom(?CORE:get_advice_function(ATAdv)), [TreeDetailsVar, TreeTuple]) || ATAdv <- ATAdvs], + [?ES:clause([TreeCatchClausePattern], [], TreeCatchClauseBody)]. + +-spec after_final_advice_calls([?CORE:advice()]) -> [?ES:syntaxTree()]. +after_final_advice_calls(AFAdvs) -> + TreeDetailsVar = get_target_function_details_var(), + [?ES:application(?ES:atom(?CORE:get_advice_module(AFAdv)), ?ES:atom(?CORE:get_advice_function(AFAdv)), [TreeDetailsVar]) || AFAdv <- AFAdvs]. + +-spec before_advice_calls([?CORE:advice()]) -> [?ES:syntaxTree()]. +before_advice_calls(BAdvs) -> + TreeDetailsVar = get_target_function_details_var(), + [?ES:application(?ES:atom(?CORE:get_advice_module(BAdv)), ?ES:atom(?CORE:get_advice_function(BAdv)), [TreeDetailsVar]) || BAdv <- BAdvs]. + +-spec after_advice_calls([?CORE:advice()]) -> [?ES:syntaxTree()]. +after_advice_calls(AftAdvs) -> + TreeRVar = get_target_function_result_var(), + TreeDetailsVar = get_target_function_details_var(), + [?ES:application(?ES:atom(?CORE:get_advice_module(AftAdv)), ?ES:atom(?CORE:get_advice_function(AftAdv)), [TreeDetailsVar, TreeRVar]) || AftAdv <- AftAdvs]. + +-spec apply_args([?CORE:advice()]) -> [?ES:syntaxTree()]. +%% These are the arguments passed to erlang:apply in: +%% ?ES:application(?ES:atom('erlang'), ?ES:atom('apply'), apply_args(ArAdvs)); +apply_args(ArAdvs) -> + TreeDetailsVar = get_target_function_details_var(), + lists:foldl( + fun (AroundAdvice, []) -> + [?ES:atom(?CORE:get_advice_module(AroundAdvice)), ?ES:atom(?CORE:get_advice_function(AroundAdvice)), ?ES:list([TreeDetailsVar])]; + (AroundAdvice, Acc) -> + [?ES:atom(?CORE:get_advice_module(AroundAdvice)), ?ES:atom(?CORE:get_advice_function(AroundAdvice)), Acc] + end, [], ArAdvs). + +-spec get_target_function_result_var() -> ?ES:syntaxTree(). +get_target_function_result_var() -> + ?ES:variable("R"). + +-spec around_and_after_advice_calls(ArAdvs::[?CORE:advice()], AftAdvs::[?CORE:advice()], TreeTargetFCall::?ES:syntaxTree()) -> [?ES:syntaxTree()]. +around_and_after_advice_calls([], [], TreeTargetFCall) -> + %% no need for apply, no need for R + %% call target function + [TreeTargetFCall]; +around_and_after_advice_calls(ArAdvs, [], _) -> + %% no need for R + %% need to apply; target function will be called by user in around advice + [?ES:application(?ES:atom('erlang'), ?ES:atom('apply'), apply_args(ArAdvs))]; +around_and_after_advice_calls([], AftAdvs, TreeTargetFCall) -> + %% no need for apply + %% call target function and bind result to R, then pass R to AftAdvs + TreeMatchR = ?ES:match_expr(get_target_function_result_var(), TreeTargetFCall), + [TreeMatchR | after_advice_calls(AftAdvs)]; +around_and_after_advice_calls(ArAdvs, AftAdvs, _) -> + %% need apply; need to bind result of apply to R, and then pass R to AftAdvs + TreeMatchR = ?ES:match_expr(get_target_function_result_var(), ?ES:application(?ES:atom('erlang'), ?ES:atom('apply'), apply_args(ArAdvs))), + [TreeMatchR | after_advice_calls(AftAdvs)]. + +%% TargetFDetails = [TargetFunctionModule, TargetFunctionName, [P1, .., PN]] +-spec transform_functiondef(TreeF::?ES:syntaxTree(), TreeModuleName::?ES:syntaxTree(), AG::#adv_grps{}) -> TreeTransformedFunction::?ES:syntaxTree(). +transform_functiondef(TreeF, TreeModuleName, AG) -> + TreeTargetFName = ?ES:atom(?ES:atom_name(?ES:function_name(TreeF)) ++ ?TARGET_SUFFIX), + TreeProxyF = proxy_function(TreeF, TreeModuleName, TreeTargetFName, AG), + case AG#adv_grps.around of + [] -> + ?ES:form_list([TreeProxyF, ?ES:function(TreeTargetFName, ?ES:function_clauses(TreeF))]); + _ -> + TreeFA = ?ES:arity_qualifier(TreeTargetFName, ?ES:integer(?ES:function_arity(TreeF))), + TreeExportAttr = ?ES:attribute(?ES:atom(export), [?ES:list([TreeFA])]), + ?ES:form_list([TreeExportAttr, TreeProxyF, ?ES:function(TreeTargetFName, ?ES:function_clauses(TreeF))]) + end. + +-spec generate_vars(N::integer()) -> Vars::[?ES:syntaxTree()]. +%% @doc Vars is a list of syntaxTree() variables generated by erl_syntax:variable/1. They are named sequentially from P1 up to PN +generate_vars(N) -> + [?ES:variable("P" ++ integer_to_list(X)) || X <- lists:seq(1, N)]. + +-spec foldlfun(?ES:syntaxTree(), ?ES:syntaxTree(), Arity::?ES:syntaxTree(), ?ES:syntaxTree(), pid()) -> ?ES:syntaxTree(). +foldlfun(ModName, FunName, Arity, MsgFormatVar, WeaverNotesPid) -> + %% --------------------- + %% generated variables: + DeltaAfterAdvicesVar = generate_variable("DeltaAfterAdvices", WeaverNotesPid), + MsgInfoFunVar = generate_variable("MsgInfoFun", WeaverNotesPid), + AdviceIdVar = generate_variable("AdviceId", WeaverNotesPid), + AdviceModuleVar = generate_variable("AdviceModule", WeaverNotesPid), + AdviceFunctionVar = generate_variable("AdviceFunction", WeaverNotesPid), + AfterAdviceVar = generate_variable("AfterAdvice", WeaverNotesPid), + %% --------------------- + ?ES:fun_expr([ + ?ES:clause([MsgInfoFunVar, DeltaAfterAdvicesVar], none, [ + ?ES:case_expr(?ES:application(MsgInfoFunVar, [MsgFormatVar]), [ + ?ES:clause([?ES:atom(undefined)], none, [DeltaAfterAdvicesVar]), + ?ES:clause([?ES:tuple([AdviceIdVar, ?ES:atom(before), AdviceModuleVar, AdviceFunctionVar])], none, [ + ?ES:application(AdviceModuleVar, AdviceFunctionVar, [ ?ES:list([AdviceIdVar, ModName, FunName, Arity, MsgFormatVar]) ]), + DeltaAfterAdvicesVar + ]), + ?ES:clause([AfterAdviceVar], none, [?ES:list([AfterAdviceVar], DeltaAfterAdvicesVar)]) + ]) %% case end + ]) %% fun clause end + ]). + +-spec foreachfun(?ES:syntaxTree(), ?ES:syntaxTree(), Arity::?ES:syntaxTree(), ?ES:syntaxTree(), pid()) -> ?ES:syntaxTree(). +foreachfun(ModName, FunName, Arity, MsgFormatVar, WeaverNotesPid) -> + %% --------------------- + %% generated variables: + AdviceIdVar = generate_variable("AdviceId", WeaverNotesPid), + AdviceModuleVar = generate_variable("AdviceModule", WeaverNotesPid), + AdviceFunctionVar = generate_variable("AdviceFunction", WeaverNotesPid), + %% --------------------- + ?ES:fun_expr([ + ?ES:clause([?ES:tuple([AdviceIdVar, ?ES:atom('after'), AdviceModuleVar, AdviceFunctionVar])], none, [ + ?ES:application(AdviceModuleVar, AdviceFunctionVar, [ ?ES:list([AdviceIdVar, ModName, FunName, Arity, MsgFormatVar]) ]) + ]), + %% This catch-all clause should never be used + ?ES:clause([?ES:underscore()], none, [?ES:atom(ok)]) + ]). + +%% Assumes Node is an infix_expr node with an ?ES::operator_name(?ES:infix_expr_operator(Node)) == '!' +transform_send(Node, WeaverNotesPid) -> + %% --------------------- + %% generated variables: + MsgFormatVar = generate_variable("MsgFormat", WeaverNotesPid), + AfterAdvicesListVar = generate_variable("AfterAdvicesList", WeaverNotesPid), + %% --------------------- + GetSendMsgInfo = ?ES:application(?ES:atom(send_msg_info_function_name()), []), + TreeCurrentModule = get_current_module(WeaverNotesPid), + TreeCurrentFunction = get_current_function(WeaverNotesPid), + TreeCurrentFunctionArity = ?ES:integer(get_current_function_arity(WeaverNotesPid)), + %% Replace Node with a block expression + ?ES:block_expr([ + %% bind right operand to variable so that any expressions in right operand are only evaluated once + ?ES:match_expr(MsgFormatVar, ?ES:infix_expr_right(Node)), + ?ES:match_expr(AfterAdvicesListVar, + ?ES:application(?ES:atom(lists), ?ES:atom(foldl), [foldlfun(TreeCurrentModule, TreeCurrentFunction, TreeCurrentFunctionArity, MsgFormatVar, WeaverNotesPid), + ?ES:nil(), GetSendMsgInfo]) + ), + ?ES:infix_expr(?ES:infix_expr_left(Node), ?ES:infix_expr_operator(Node), MsgFormatVar), + ?ES:application(?ES:atom(lists), ?ES:atom(foreach), [foreachfun(TreeCurrentModule, TreeCurrentFunction, TreeCurrentFunctionArity, MsgFormatVar, WeaverNotesPid), + AfterAdvicesListVar]), + %% return result of ! + MsgFormatVar + ]). + +%% Assumes Node is of type receive_expr +transform_receive(Node, WeaverNotesPid) -> + GetReceiveMsgInfo = ?ES:application(?ES:atom(receive_msg_info_function_name()), []), + TreeCurrentModule = get_current_module(WeaverNotesPid), + TreeCurrentFunction = get_current_function(WeaverNotesPid), + Arity = get_current_function_arity(WeaverNotesPid), + TreeCurrentFunctionArity = ?ES:integer(Arity), + ReceiveClauses = ?ES:receive_expr_clauses(Node), + TransformedReceiveClauses = lists:reverse(lists:foldl( + fun(ReceiveClause, DeltaTransformedReceiveClauses) -> + %% --------------------- + %% generated variables: + MsgFormatVar = generate_variable("MsgFormat", WeaverNotesPid), + AfterAdvicesListVar = generate_variable("AfterAdvicesList", WeaverNotesPid), + %% --------------------- + Patterns = ?ES:clause_patterns(ReceiveClause), + Pattern = hd(Patterns), + NewClausePattern = ?ES:match_expr(MsgFormatVar, Pattern), + Body = ?ES:clause_body(ReceiveClause), + LastExpr = lists:last(Body), + %% transform body + NewBody = + case is_tail_recursive_call(LastExpr, ?ES:atom_value(TreeCurrentModule), ?ES:atom_value(TreeCurrentFunction), Arity) of + true -> + %% remove LastExpr from Body + BodyNoTailRecursion = lists:reverse(tl(lists:reverse(Body))), + [ + ?ES:match_expr(AfterAdvicesListVar, + ?ES:application(?ES:atom(lists), ?ES:atom(foldl), [foldlfun(TreeCurrentModule, TreeCurrentFunction, TreeCurrentFunctionArity, MsgFormatVar, WeaverNotesPid), + ?ES:nil(), GetReceiveMsgInfo]) + ), + ?ES:block_expr(BodyNoTailRecursion), + ?ES:application(?ES:atom(lists), ?ES:atom(foreach), [foreachfun(TreeCurrentModule, TreeCurrentFunction, TreeCurrentFunctionArity, MsgFormatVar, WeaverNotesPid), + AfterAdvicesListVar]), + %% make tail recursive call + LastExpr + ]; + false -> + %% --------------------- + %% generated variables: + ReturnValVar = generate_variable("ReturnVal", WeaverNotesPid), + %% --------------------- + [ + ?ES:match_expr(AfterAdvicesListVar, + ?ES:application(?ES:atom(lists), ?ES:atom(foldl), [foldlfun(TreeCurrentModule, TreeCurrentFunction, TreeCurrentFunctionArity, MsgFormatVar, WeaverNotesPid), + ?ES:nil(), GetReceiveMsgInfo]) + ), + ?ES:match_expr(ReturnValVar, ?ES:block_expr(Body)), + ?ES:application(?ES:atom(lists), ?ES:atom(foreach), [foreachfun(TreeCurrentModule, TreeCurrentFunction, TreeCurrentFunctionArity, MsgFormatVar, WeaverNotesPid), + AfterAdvicesListVar]), + ReturnValVar + ] + end, + [?ES:clause([NewClausePattern], ?ES:clause_guard(ReceiveClause), NewBody) | DeltaTransformedReceiveClauses] + end, [], ReceiveClauses)), + ?ES:receive_expr(TransformedReceiveClauses, ?ES:receive_expr_timeout(Node), ?ES:receive_expr_action(Node)). + +-spec is_tail_recursive_call(?ES:syntaxTree(), ModuleName::atom(), FunctionName::atom(), Arity::integer()) -> boolean(). +%% @doc Checks whether the given Node is an application of the form ModuleName:FunctionName/Arity or FunctionName/Arity +is_tail_recursive_call(Node, ModuleName, FunctionName, Arity) -> + case ?ES:type(Node) of + application -> + is_application_tail_recursive_call(Node, ModuleName, FunctionName, Arity); + _ -> + false + end. + +-spec is_application_tail_recursive_call(Node::?ES:syntaxTree(), ModuleName::atom(), FunctionName::atom(), Arity::integer()) -> boolean(). +%% @doc Checks whether the given Node is an application of the form ModuleName:FunctionName/Arity or FunctionName/Arity. Assumes erl_syntax:type(Node) == 'application' +is_application_tail_recursive_call(Node, ModuleName, FunctionName, Arity) -> + %% Check both the arity and the correct function being called + AppOpNode = ?ES:application_operator(Node), + case is_correct_mod_fun_for_tail_recursive_call(AppOpNode, ModuleName, FunctionName) of + true -> + length(?ES:application_arguments(Node)) =:= Arity; + false -> + false + end. + +-spec is_correct_mod_fun_for_tail_recursive_call(AppOpNode::?ES:syntaxTree(), ModuleName::atom(), FunctionName::atom()) -> boolean(). +%% @doc Determines whether AppOpNode is an application operator of the form ModuleName:FunctionName or FunctionName +is_correct_mod_fun_for_tail_recursive_call(AppOpNode, ModuleName, FunctionName) -> + case ?ES:type(AppOpNode) of + atom -> + ?ES:atom_value(AppOpNode) =:= FunctionName; + module_qualifier -> + ?ES:atom_value(?ES:module_qualifier_argument(AppOpNode)) =:= ModuleName andalso ?ES:atom_value(?ES:module_qualifier_body(AppOpNode)) =:= FunctionName; + _ -> + false + end. + +-spec generate_variable(atom(), pid()) -> ?ES:syntaxTree(); + (string(), pid()) -> ?ES:syntaxTree(). +generate_variable(Name, WeaverNotesPid) when is_atom(Name) -> + generate_variable(atom_to_list(Name), WeaverNotesPid); +generate_variable(Name, WeaverNotesPid) when is_list(Name) -> + GenVarId = get_gen_var_id(WeaverNotesPid), + VarName = Name ++ integer_to_list(GenVarId) ++ ?SUFFIX, + ?ES:variable(VarName). + +send_msg_info_function_name() -> + list_to_atom("get_send_msg_info" ++ ?SUFFIX). + +receive_msg_info_function_name() -> + list_to_atom("get_receive_msg_info" ++ ?SUFFIX). + +-spec msg_info_function(FunctionName::atom(), [?CORE:aspect()]) -> Function::?ES:syntaxTree(); + (atom(), ?CORE:aspect()) -> ?ES:syntaxTree(). +%% @doc Given an aspect or list of aspects, returns a syntaxTree() representation of the following: +%% FunctionName() -> +%% [fun(..) -> .. ; (_) -> undefined end, fun(..) -> .. ; (_) -> undefined end]. +msg_info_function(FunctionName, Aspects) when is_list(Aspects) -> + %% Collect all tuples to put in the list returned by get_send_msg_info + ForEachAdviceInAspect = + fun(Aspect) -> + ForEachPointcutInAdvice = + fun(Advice) -> + [msg_info_fun(Advice, Pointcut) || Pointcut <- ?CORE:advpointcuts(Advice)] + end, + [ForEachPointcutInAdvice(Advice) || Advice <- ?CORE:aadvice(Aspect)] + end, + MsgInfoFunList = ?UTIL:filter_out(undefined, lists:flatten([ForEachAdviceInAspect(Aspect) || Aspect <- Aspects])), + ?ES:function(?ES:atom(FunctionName), [ + ?ES:clause([], none, [?ES:list(MsgInfoFunList)]) + ]); +msg_info_function(FunctionName, Aspect) -> + msg_info_function(FunctionName, [Aspect]). + +%% You might later add, PassContainingFunctionArguments, a boolean() which determines whether to pass the arguments passed to the function containing the send/receive to the advice or not. +-spec msg_info_fun(Advice::?CORE:advice(), Pointcut::?CORE:pointcut()) -> ?ES:syntaxTree() | undefined. +%% @doc Returns a syntaxTree() encoding the following: +%% fun(SendMsgFormat) -> +%% {PointcutId, AdviceType, AdviceModule, AdviceFunction}; +%% (_) -> +%% undefined +%% end. +%% Where: +%% SendMsgFormat = to_form(?CORE:get_send_msg(Pointcut)) %% i.e. the form representation of the string send_msg +%% PointcutId = ?CORE:get_id(Pointcut) +%% AdviceType = ?CORE:get_type(Advice) +%% {AdviceModule, AdviceFunction} = ?CORE:get_mf(Advice) +msg_info_fun(Advice, Pointcut) -> + case ?CORE:get_msg_format(Pointcut) of + undefined -> + undefined; + MsgFormat -> + AdviceType = ?CORE:get_type(Advice), + {ModuleName, FunctionName} = ?CORE:get_mf(Advice), + Clause1Body = ?ES:tuple([?ES:atom(?CORE:get_id(Pointcut)), ?ES:atom(AdviceType), + ?ES:atom(ModuleName), ?ES:atom(FunctionName)]), + Clause1 = ?ES:clause([to_form(MsgFormat)], none, [Clause1Body]), + CatchAllClause = ?ES:clause([?ES:underscore()], none, [?ES:atom('undefined')]), + ?ES:fun_expr([Clause1, CatchAllClause]) + end. + +%% to_form(string()) -> abstract form +to_form(MsgFStr) -> + {_, Tokens, _} = erl_scan:string(end_with_period(MsgFStr)), + {_, Exprs} = erl_parse:parse_exprs(Tokens), + hd(Exprs). + +end_with_period(String) -> + case lists:last(String) of + $. -> String; + _ -> String ++ "." + end. + +%% +%% Weaver notes: A process to help with weaving +%% + +-record(notes,{ + current_mod :: ?ES:syntaxTree(), + current_fun :: ?ES:syntaxTree(), + current_fun_arity :: integer(), + gen_var_id = 0 :: integer(), + parent_pid :: pid() +}). + +%% @doc Used to keep track of some state while traversing the abstract syntax tree. +weaver_notes(State = #notes{current_mod = CurrentMod, current_fun = CurrentFun, current_fun_arity = CurrentArity, gen_var_id = GenVarId, parent_pid = ParentPid}) -> + receive + {Pid, current_mod, NewCurrentModule} -> + Pid ! {self(), ok}, + weaver_notes(State#notes{current_mod = NewCurrentModule}); + {Pid, current_fun, NewCurrentFunction} -> + Pid ! {self(), ok}, + weaver_notes(State#notes{current_fun = NewCurrentFunction}); + {Pid, current_fun_arity, NewCurrentArity} -> + Pid ! {self(), ok}, + weaver_notes(State#notes{current_fun_arity = NewCurrentArity}); + {Pid, current_mod} -> + Pid ! {self(), current_mod, CurrentMod}, + weaver_notes(State); + {Pid, current_fun} -> + Pid ! {self(), current_fun, CurrentFun}, + weaver_notes(State); + {Pid, current_fun_arity} -> + Pid ! {self(), current_fun_arity, CurrentArity}, + weaver_notes(State); + {Pid, gen_var_id} -> + Pid ! {self(), gen_var_id, GenVarId}, + weaver_notes(State#notes{gen_var_id = GenVarId + 1}); + {Pid, exit} -> + Pid ! {self(), ok}; + {'EXIT', ParentPid, normal} -> + ok + after 10000 -> + case erlang:is_process_alive(ParentPid) of + true -> + weaver_notes(State); + false -> + io:format("Stopping orphan weaver_notes with pid ~p and parent pid ~p\n", [self(), ParentPid]) + end + end. + +-spec start_weaver_notes() -> pid(). +start_weaver_notes() -> + Pid = self(), + erlang:spawn_link(fun() -> weaver_notes(#notes{parent_pid = Pid}) end). + +-spec get_current_module(pid()) -> ?ES:syntaxTree(). +get_current_module(Pid) -> + Pid ! {self(), current_mod}, + receive {Pid, current_mod, CurrentModule} -> CurrentModule end. + +-spec get_current_function(pid()) -> ?ES:syntaxTree(). +get_current_function(Pid) -> + Pid ! {self(), current_fun}, + receive {Pid, current_fun, CurrentFunction} -> CurrentFunction end. + +-spec get_current_function_arity(pid()) -> integer(). +get_current_function_arity(Pid) -> + Pid ! {self(), current_fun_arity}, + receive {Pid, current_fun_arity, Arity} -> Arity end. + +-spec set_current_module(pid(), ?ES:syntaxTree()) -> ok. +set_current_module(Pid, Module) -> + Pid ! {self(), current_mod, Module}, + receive {Pid, ok} -> ok end. + +-spec set_current_function(pid(), ?ES:syntaxTree()) -> ok. +set_current_function(Pid, Function) -> + Pid ! {self(), current_fun, Function}, + receive {Pid, ok} -> ok end. + +-spec set_current_function_arity(pid(), integer()) -> ok. +set_current_function_arity(Pid, Arity) -> + Pid ! {self(), current_fun_arity, Arity}, + receive {Pid, ok} -> ok end. + +-spec get_gen_var_id(pid()) -> integer(). +get_gen_var_id(Pid) -> + Pid ! {self(), gen_var_id}, + receive {Pid, gen_var_id, GenVarId} -> GenVarId end. + +-spec stop_weaver_notes(pid()) -> ok. +stop_weaver_notes(Pid) -> + Pid ! {self(), exit}, + receive {Pid, ok} -> ok end. + diff --git a/todo.txt b/todo.txt new file mode 100644 index 0000000..830c0c4 --- /dev/null +++ b/todo.txt @@ -0,0 +1,14 @@ +> See whether eaopcore:get_send_msg/1 can be deleted. + +> Find out which functions each module should export and export them, removing the -compile(export_all). + +> The transformations taking place are now defined and not expected to change. Write tests to guard against regressions in future changes. Tests which compare the generated abstract forms with the expected abstract forms are ok. + +> Add a description to each module. + +> Add a -spec to all functions. + +> Run dialyzer on project. + +> Implement args, within, not_within, spawned, registered, trap_exit, (and maybe visibility). +