%% ===================================================================== %% This library is free software; you can redistribute it and/or modify %% it under the terms of the GNU Lesser General Public License as %% published by the Free Software Foundation; either version 2 of the %% License, or (at your option) any later version. %% %% This library is distributed in the hope that it will be useful, but %% WITHOUT ANY WARRANTY; without even the implied warranty of %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU %% Lesser General Public License for more details. %% %% You should have received a copy of the GNU Lesser General Public %% License along with this library; if not, write to the Free Software %% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 %% USA %% %% $Id$ %% %% @copyright 1997-2006 Richard Carlsson %% @author Richard Carlsson %% @end %% ===================================================================== %% @doc Support library for abstract Erlang syntax trees. %% %% This module contains utility functions for working with the %% abstract data type defined in the module {@link erl_syntax}. %% %% @type syntaxTree() = erl_syntax:syntaxTree(). An abstract syntax %% tree. See the {@link erl_syntax} module for details. -module(erl_syntax_lib). -export([analyze_application/1, analyze_attribute/1, analyze_export_attribute/1, analyze_file_attribute/1, analyze_form/1, analyze_forms/1, analyze_function/1, analyze_function_name/1, analyze_implicit_fun/1, analyze_import_attribute/1, analyze_module_attribute/1, analyze_record_attribute/1, analyze_record_expr/1, analyze_record_field/1, analyze_rule/1, analyze_wild_attribute/1, annotate_bindings/1, annotate_bindings/2, fold/3, fold_subtrees/3, foldl_listlist/3, function_name_expansions/1, is_fail_expr/1, limit/2, limit/3, map/2, map_subtrees/2, mapfold/3, mapfold_subtrees/3, mapfoldl_listlist/3, new_variable_name/1, new_variable_name/2, new_variable_names/2, new_variable_names/3, strip_comments/1, to_comment/1, to_comment/2, to_comment/3, variables/1]). -export_type([info_pair/0]). %% ===================================================================== -type ordset(X) :: [X]. % XXX: TAKE ME OUT %% ===================================================================== %% @spec map(Function, Tree::syntaxTree()) -> syntaxTree() %% %% Function = (syntaxTree()) -> syntaxTree() %% %% @doc Applies a function to each node of a syntax tree. The result of %% each application replaces the corresponding original node. The order %% of traversal is bottom-up. %% %% @see map_subtrees/2 -spec map(fun((erl_syntax:syntaxTree()) -> erl_syntax:syntaxTree()), erl_syntax:syntaxTree()) -> erl_syntax:syntaxTree(). map(F, Tree) -> case erl_syntax:subtrees(Tree) of [] -> F(Tree); Gs -> Tree1 = erl_syntax:make_tree(erl_syntax:type(Tree), [[map(F, T) || T <- G] || G <- Gs]), F(erl_syntax:copy_attrs(Tree, Tree1)) end. %% ===================================================================== %% @spec map_subtrees(Function, syntaxTree()) -> syntaxTree() %% %% Function = (Tree) -> Tree1 %% %% @doc Applies a function to each immediate subtree of a syntax tree. %% The result of each application replaces the corresponding original %% node. %% %% @see map/2 -spec map_subtrees(fun((erl_syntax:syntaxTree()) -> erl_syntax:syntaxTree()), erl_syntax:syntaxTree()) -> erl_syntax:syntaxTree(). map_subtrees(F, Tree) -> case erl_syntax:subtrees(Tree) of [] -> Tree; Gs -> Tree1 = erl_syntax:make_tree(erl_syntax:type(Tree), [[F(T) || T <- G] || G <- Gs]), erl_syntax:copy_attrs(Tree, Tree1) end. %% ===================================================================== %% @spec fold(Function, Start::term(), Tree::syntaxTree()) -> term() %% %% Function = (syntaxTree(), term()) -> term() %% %% @doc Folds a function over all nodes of a syntax tree. The result is %% the value of `Function(X1, Function(X2, ... Function(Xn, Start) %% ... ))', where `[X1, X2, ..., Xn]' are the nodes of %% `Tree' in a post-order traversal. %% %% @see fold_subtrees/3 %% @see foldl_listlist/3 -spec fold(fun((erl_syntax:syntaxTree(), term()) -> term()), term(), erl_syntax:syntaxTree()) -> term(). fold(F, S, Tree) -> case erl_syntax:subtrees(Tree) of [] -> F(Tree, S); Gs -> F(Tree, fold_1(F, S, Gs)) end. fold_1(F, S, [L | Ls]) -> fold_1(F, fold_2(F, S, L), Ls); fold_1(_, S, []) -> S. fold_2(F, S, [T | Ts]) -> fold_2(F, fold(F, S, T), Ts); fold_2(_, S, []) -> S. %% ===================================================================== %% @spec fold_subtrees(Function, Start::term(), Tree::syntaxTree()) -> %% term() %% %% Function = (syntaxTree(), term()) -> term() %% %% @doc Folds a function over the immediate subtrees of a syntax tree. %% This is similar to `fold/3', but only on the immediate %% subtrees of `Tree', in left-to-right order; it does not %% include the root node of `Tree'. %% %% @see fold/3 -spec fold_subtrees(fun((erl_syntax:syntaxTree(), term()) -> term()), term(), erl_syntax:syntaxTree()) -> term(). fold_subtrees(F, S, Tree) -> foldl_listlist(F, S, erl_syntax:subtrees(Tree)). %% ===================================================================== %% @spec foldl_listlist(Function, Start::term(), [[term()]]) -> term() %% %% Function = (term(), term()) -> term() %% %% @doc Like `lists:foldl/3', but over a list of lists. %% %% @see fold/3 %% @see //stdlib/lists:foldl/3 -spec foldl_listlist(fun((term(), term()) -> term()), term(), [[term()]]) -> term(). foldl_listlist(F, S, [L | Ls]) -> foldl_listlist(F, foldl(F, S, L), Ls); foldl_listlist(_, S, []) -> S. foldl(F, S, [T | Ts]) -> foldl(F, F(T, S), Ts); foldl(_, S, []) -> S. %% ===================================================================== %% @spec mapfold(Function, Start::term(), Tree::syntaxTree()) -> %% {syntaxTree(), term()} %% %% Function = (syntaxTree(), term()) -> {syntaxTree(), term()} %% %% @doc Combines map and fold in a single operation. This is similar to %% `map/2', but also propagates an extra value from each %% application of the `Function' to the next, while doing a %% post-order traversal of the tree like `fold/3'. The value %% `Start' is passed to the first function application, and %% the final result is the result of the last application. %% %% @see map/2 %% @see fold/3 -spec mapfold(fun((erl_syntax:syntaxTree(), term()) -> {erl_syntax:syntaxTree(), term()}), term(), erl_syntax:syntaxTree()) -> {erl_syntax:syntaxTree(), term()}. mapfold(F, S, Tree) -> case erl_syntax:subtrees(Tree) of [] -> F(Tree, S); Gs -> {Gs1, S1} = mapfold_1(F, S, Gs), Tree1 = erl_syntax:make_tree(erl_syntax:type(Tree), Gs1), F(erl_syntax:copy_attrs(Tree, Tree1), S1) end. mapfold_1(F, S, [L | Ls]) -> {L1, S1} = mapfold_2(F, S, L), {Ls1, S2} = mapfold_1(F, S1, Ls), {[L1 | Ls1], S2}; mapfold_1(_, S, []) -> {[], S}. mapfold_2(F, S, [T | Ts]) -> {T1, S1} = mapfold(F, S, T), {Ts1, S2} = mapfold_2(F, S1, Ts), {[T1 | Ts1], S2}; mapfold_2(_, S, []) -> {[], S}. %% ===================================================================== %% @spec mapfold_subtrees(Function, Start::term(), %% Tree::syntaxTree()) -> {syntaxTree(), term()} %% %% Function = (syntaxTree(), term()) -> {syntaxTree(), term()} %% %% @doc Does a mapfold operation over the immediate subtrees of a syntax %% tree. This is similar to `mapfold/3', but only on the %% immediate subtrees of `Tree', in left-to-right order; it %% does not include the root node of `Tree'. %% %% @see mapfold/3 -spec mapfold_subtrees(fun((erl_syntax:syntaxTree(), term()) -> {erl_syntax:syntaxTree(), term()}), term(), erl_syntax:syntaxTree()) -> {erl_syntax:syntaxTree(), term()}. mapfold_subtrees(F, S, Tree) -> case erl_syntax:subtrees(Tree) of [] -> {Tree, S}; Gs -> {Gs1, S1} = mapfoldl_listlist(F, S, Gs), Tree1 = erl_syntax:make_tree(erl_syntax:type(Tree), Gs1), {erl_syntax:copy_attrs(Tree, Tree1), S1} end. %% ===================================================================== %% @spec mapfoldl_listlist(Function, State, [[term()]]) -> %% {[[term()]], term()} %% %% Function = (term(), term()) -> {term(), term()} %% %% @doc Like `lists:mapfoldl/3', but over a list of lists. %% The list of lists in the result has the same structure as the given %% list of lists. -spec mapfoldl_listlist(fun((term(), term()) -> {term(), term()}), term(), [[term()]]) -> {[[term()]], term()}. mapfoldl_listlist(F, S, [L | Ls]) -> {L1, S1} = mapfoldl(F, S, L), {Ls1, S2} = mapfoldl_listlist(F, S1, Ls), {[L1 | Ls1], S2}; mapfoldl_listlist(_, S, []) -> {[], S}. mapfoldl(F, S, [L | Ls]) -> {L1, S1} = F(L, S), {Ls1, S2} = mapfoldl(F, S1, Ls), {[L1 | Ls1], S2}; mapfoldl(_, S, []) -> {[], S}. %% ===================================================================== %% @spec variables(syntaxTree()) -> set(atom()) %% %% set(T) = //stdlib/sets:set(T) %% %% @doc Returns the names of variables occurring in a syntax tree, The %% result is a set of variable names represented by atoms. Macro names %% are not included. %% %% @see //stdlib/sets -spec variables(erl_syntax:syntaxTree()) -> set(). variables(Tree) -> variables(Tree, sets:new()). variables(T, S) -> case erl_syntax:type(T) of variable -> sets:add_element(erl_syntax:variable_name(T), S); macro -> %% macro names are ignored, even if represented by variables case erl_syntax:macro_arguments(T) of none -> S; As -> variables_2(As, S) end; _ -> case erl_syntax:subtrees(T) of [] -> S; Gs -> variables_1(Gs, S) end end. variables_1([L | Ls], S) -> variables_1(Ls, variables_2(L, S)); variables_1([], S) -> S. variables_2([T | Ts], S) -> variables_2(Ts, variables(T, S)); variables_2([], S) -> S. -define(MINIMUM_RANGE, 100). -define(START_RANGE_FACTOR, 100). -define(MAX_RETRIES, 3). % retries before enlarging range -define(ENLARGE_ENUM, 8). % range enlargment enumerator -define(ENLARGE_DENOM, 1). % range enlargment denominator default_variable_name(N) -> list_to_atom("V" ++ integer_to_list(N)). %% ===================================================================== %% @spec new_variable_name(Used::set(atom())) -> atom() %% %% @doc Returns an atom which is not already in the set `Used'. This is %% equivalent to `new_variable_name(Function, Used)', where `Function' %% maps a given integer `N' to the atom whose name consists of "`V'" %% followed by the numeral for `N'. %% %% @see new_variable_name/2 -spec new_variable_name(set()) -> atom(). new_variable_name(S) -> new_variable_name(fun default_variable_name/1, S). %% ===================================================================== %% @spec new_variable_name(Function, Used::set(atom())) -> atom() %% %% Function = (integer()) -> atom() %% %% @doc Returns a user-named atom which is not already in the set %% `Used'. The atom is generated by applying the given %% `Function' to a generated integer. Integers are generated %% using an algorithm which tries to keep the names randomly distributed %% within a reasonably small range relative to the number of elements in %% the set. %% %% This function uses the module `random' to generate new %% keys. The seed it uses may be initialized by calling %% `random:seed/0' or `random:seed/3' before this %% function is first called. %% %% @see new_variable_name/1 %% @see //stdlib/sets %% @see //stdlib/random -spec new_variable_name(fun((integer()) -> atom()), set()) -> atom(). new_variable_name(F, S) -> R = start_range(S), new_variable_name(R, F, S). new_variable_name(R, F, S) -> new_variable_name(generate(R, R), R, 0, F, S). new_variable_name(N, R, T, F, S) when T < ?MAX_RETRIES -> A = F(N), case sets:is_element(A, S) of true -> new_variable_name(generate(N, R), R, T + 1, F, S); false -> A end; new_variable_name(N, R, _T, F, S) -> %% Too many retries - enlarge the range and start over. R1 = (R * ?ENLARGE_ENUM) div ?ENLARGE_DENOM, new_variable_name(generate(N, R1), R1, 0, F, S). %% Note that we assume that it is very cheap to take the size of %% the given set. This should be valid for the stdlib %% implementation of `sets'. start_range(S) -> erlang:max(sets:size(S) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE). %% The previous number might or might not be used to compute the %% next number to be tried. It is currently not used. %% %% It is important that this function does not generate values in %% order, but (pseudo-)randomly distributed over the range. generate(_Key, Range) -> random:uniform(Range). % works well %% ===================================================================== %% @spec new_variable_names(N::integer(), Used::set(atom())) -> [atom()] %% %% @doc Like `new_variable_name/1', but generates a list of %% `N' new names. %% %% @see new_variable_name/1 -spec new_variable_names(integer(), set()) -> [atom()]. new_variable_names(N, S) -> new_variable_names(N, fun default_variable_name/1, S). %% ===================================================================== %% @spec new_variable_names(N::integer(), Function, %% Used::set(atom())) -> [atom()] %% %% Function = (integer()) -> atom() %% %% @doc Like `new_variable_name/2', but generates a list of %% `N' new names. %% %% @see new_variable_name/2 -spec new_variable_names(integer(), fun((integer()) -> atom()), set()) -> [atom()]. new_variable_names(N, F, S) when is_integer(N) -> R = start_range(S), new_variable_names(N, [], R, F, S). new_variable_names(N, Names, R, F, S) when N > 0 -> Name = new_variable_name(R, F, S), S1 = sets:add_element(Name, S), new_variable_names(N - 1, [Name | Names], R, F, S1); new_variable_names(0, Names, _, _, _) -> Names. %% ===================================================================== %% @spec annotate_bindings(Tree::syntaxTree(), %% Bindings::ordset(atom())) -> syntaxTree() %% %% @type ordset(T) = //stdlib/ordsets:ordset(T) %% %% @doc Adds or updates annotations on nodes in a syntax tree. %% `Bindings' specifies the set of bound variables in the %% environment of the top level node. The following annotations are %% affected: %% %% `Bindings' and `Vars' are ordered-set lists %% (cf. module `ordsets') of atoms representing variable %% names. %% %% @see annotate_bindings/1 %% @see //stdlib/ordsets -spec annotate_bindings(erl_syntax:syntaxTree(), ordset(atom())) -> erl_syntax:syntaxTree(). annotate_bindings(Tree, Env) -> {Tree1, _, _} = vann(Tree, Env), Tree1. %% ===================================================================== %% @spec annotate_bindings(Tree::syntaxTree()) -> syntaxTree() %% %% @doc Adds or updates annotations on nodes in a syntax tree. %% Equivalent to `annotate_bindings(Tree, Bindings)' where %% the top-level environment `Bindings' is taken from the %% annotation `{env, Bindings}' on the root node of %% `Tree'. An exception is thrown if no such annotation %% should exist. %% %% @see annotate_bindings/2 -spec annotate_bindings(erl_syntax:syntaxTree()) -> erl_syntax:syntaxTree(). annotate_bindings(Tree) -> As = erl_syntax:get_ann(Tree), case lists:keyfind(env, 1, As) of {env, InVars} -> annotate_bindings(Tree, InVars); _ -> erlang:error(badarg) end. vann(Tree, Env) -> case erl_syntax:type(Tree) of variable -> %% Variable use Bound = [], Free = [erl_syntax:variable_name(Tree)], {ann_bindings(Tree, Env, Bound, Free), Bound, Free}; match_expr -> vann_match_expr(Tree, Env); case_expr -> vann_case_expr(Tree, Env); if_expr -> vann_if_expr(Tree, Env); cond_expr -> vann_cond_expr(Tree, Env); receive_expr -> vann_receive_expr(Tree, Env); catch_expr -> vann_catch_expr(Tree, Env); try_expr -> vann_try_expr(Tree, Env); function -> vann_function(Tree, Env); rule -> vann_rule(Tree, Env); fun_expr -> vann_fun_expr(Tree, Env); list_comp -> vann_list_comp(Tree, Env); binary_comp -> vann_binary_comp(Tree, Env); generator -> vann_generator(Tree, Env); binary_generator -> vann_binary_generator(Tree, Env); block_expr -> vann_block_expr(Tree, Env); macro -> vann_macro(Tree, Env); _Type -> F = vann_list_join(Env), {Tree1, {Bound, Free}} = mapfold_subtrees(F, {[], []}, Tree), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free} end. vann_list_join(Env) -> fun (T, {Bound, Free}) -> {T1, Bound1, Free1} = vann(T, Env), {T1, {ordsets:union(Bound, Bound1), ordsets:union(Free, Free1)}} end. vann_list(Ts, Env) -> lists:mapfoldl(vann_list_join(Env), {[], []}, Ts). vann_function(Tree, Env) -> Cs = erl_syntax:function_clauses(Tree), {Cs1, {_, Free}} = vann_clauses(Cs, Env), N = erl_syntax:function_name(Tree), {N1, _, _} = vann(N, Env), Tree1 = rewrite(Tree, erl_syntax:function(N1, Cs1)), Bound = [], {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_rule(Tree, Env) -> Cs = erl_syntax:rule_clauses(Tree), {Cs1, {_, Free}} = vann_clauses(Cs, Env), N = erl_syntax:rule_name(Tree), {N1, _, _} = vann(N, Env), Tree1 = rewrite(Tree, erl_syntax:rule(N1, Cs1)), Bound = [], {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_fun_expr(Tree, Env) -> Cs = erl_syntax:fun_expr_clauses(Tree), {Cs1, {_, Free}} = vann_clauses(Cs, Env), Tree1 = rewrite(Tree, erl_syntax:fun_expr(Cs1)), Bound = [], {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_match_expr(Tree, Env) -> E = erl_syntax:match_expr_body(Tree), {E1, Bound1, Free1} = vann(E, Env), Env1 = ordsets:union(Env, Bound1), P = erl_syntax:match_expr_pattern(Tree), {P1, Bound2, Free2} = vann_pattern(P, Env1), Bound = ordsets:union(Bound1, Bound2), Free = ordsets:union(Free1, Free2), Tree1 = rewrite(Tree, erl_syntax:match_expr(P1, E1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_case_expr(Tree, Env) -> E = erl_syntax:case_expr_argument(Tree), {E1, Bound1, Free1} = vann(E, Env), Env1 = ordsets:union(Env, Bound1), Cs = erl_syntax:case_expr_clauses(Tree), {Cs1, {Bound2, Free2}} = vann_clauses(Cs, Env1), Bound = ordsets:union(Bound1, Bound2), Free = ordsets:union(Free1, Free2), Tree1 = rewrite(Tree, erl_syntax:case_expr(E1, Cs1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_if_expr(Tree, Env) -> Cs = erl_syntax:if_expr_clauses(Tree), {Cs1, {Bound, Free}} = vann_clauses(Cs, Env), Tree1 = rewrite(Tree, erl_syntax:if_expr(Cs1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_cond_expr(_Tree, _Env) -> erlang:error({not_implemented,cond_expr}). vann_catch_expr(Tree, Env) -> E = erl_syntax:catch_expr_body(Tree), {E1, _, Free} = vann(E, Env), Tree1 = rewrite(Tree, erl_syntax:catch_expr(E1)), Bound = [], {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_try_expr(Tree, Env) -> Es = erl_syntax:try_expr_body(Tree), {Es1, {Bound1, Free1}} = vann_body(Es, Env), Cs = erl_syntax:try_expr_clauses(Tree), %% bindings in the body should be available in the success case, {Cs1, {_, Free2}} = vann_clauses(Cs, ordsets:union(Env, Bound1)), Hs = erl_syntax:try_expr_handlers(Tree), {Hs1, {_, Free3}} = vann_clauses(Hs, Env), %% the after part does not export anything, yet; this might change As = erl_syntax:try_expr_after(Tree), {As1, {_, Free4}} = vann_body(As, Env), Tree1 = rewrite(Tree, erl_syntax:try_expr(Es1, Cs1, Hs1, As1)), Bound = [], Free = ordsets:union(Free1, ordsets:union(Free2, ordsets:union(Free3, Free4))), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_receive_expr(Tree, Env) -> %% The timeout action is treated as an extra clause. %% Bindings in the expiry expression are local only. Cs = erl_syntax:receive_expr_clauses(Tree), Es = erl_syntax:receive_expr_action(Tree), C = erl_syntax:clause([], Es), {[C1 | Cs1], {Bound, Free1}} = vann_clauses([C | Cs], Env), Es1 = erl_syntax:clause_body(C1), {T1, _, Free2} = case erl_syntax:receive_expr_timeout(Tree) of none -> {none, [], []}; T -> vann(T, Env) end, Free = ordsets:union(Free1, Free2), Tree1 = rewrite(Tree, erl_syntax:receive_expr(Cs1, T1, Es1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_list_comp(Tree, Env) -> Es = erl_syntax:list_comp_body(Tree), {Es1, {Bound1, Free1}} = vann_list_comp_body(Es, Env), Env1 = ordsets:union(Env, Bound1), T = erl_syntax:list_comp_template(Tree), {T1, _, Free2} = vann(T, Env1), Free = ordsets:union(Free1, ordsets:subtract(Free2, Bound1)), Bound = [], Tree1 = rewrite(Tree, erl_syntax:list_comp(T1, Es1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_list_comp_body_join() -> fun (T, {Env, Bound, Free}) -> {T1, Bound1, Free1} = case erl_syntax:type(T) of binary_generator -> vann_binary_generator(T,Env); generator -> vann_generator(T, Env); _ -> %% Bindings in filters are not %% exported to the rest of the %% body. {T2, _, Free2} = vann(T, Env), {T2, [], Free2} end, Env1 = ordsets:union(Env, Bound1), {T1, {Env1, ordsets:union(Bound, Bound1), ordsets:union(Free, ordsets:subtract(Free1, Bound))}} end. vann_list_comp_body(Ts, Env) -> F = vann_list_comp_body_join(), {Ts1, {_, Bound, Free}} = lists:mapfoldl(F, {Env, [], []}, Ts), {Ts1, {Bound, Free}}. vann_binary_comp(Tree, Env) -> Es = erl_syntax:binary_comp_body(Tree), {Es1, {Bound1, Free1}} = vann_binary_comp_body(Es, Env), Env1 = ordsets:union(Env, Bound1), T = erl_syntax:binary_comp_template(Tree), {T1, _, Free2} = vann(T, Env1), Free = ordsets:union(Free1, ordsets:subtract(Free2, Bound1)), Bound = [], Tree1 = rewrite(Tree, erl_syntax:binary_comp(T1, Es1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_binary_comp_body_join() -> fun (T, {Env, Bound, Free}) -> {T1, Bound1, Free1} = case erl_syntax:type(T) of binary_generator -> vann_binary_generator(T, Env); generator -> vann_generator(T, Env); _ -> %% Bindings in filters are not %% exported to the rest of the %% body. {T2, _, Free2} = vann(T, Env), {T2, [], Free2} end, Env1 = ordsets:union(Env, Bound1), {T1, {Env1, ordsets:union(Bound, Bound1), ordsets:union(Free, ordsets:subtract(Free1, Bound))}} end. vann_binary_comp_body(Ts, Env) -> F = vann_binary_comp_body_join(), {Ts1, {_, Bound, Free}} = lists:mapfoldl(F, {Env, [], []}, Ts), {Ts1, {Bound, Free}}. %% In list comprehension generators, the pattern variables are always %% viewed as new occurrences, shadowing whatever is in the input %% environment (thus, the pattern contains no variable uses, only %% bindings). Bindings in the generator body are not exported. vann_generator(Tree, Env) -> P = erl_syntax:generator_pattern(Tree), {P1, Bound, _} = vann_pattern(P, []), E = erl_syntax:generator_body(Tree), {E1, _, Free} = vann(E, Env), Tree1 = rewrite(Tree, erl_syntax:generator(P1, E1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_binary_generator(Tree, Env) -> P = erl_syntax:binary_generator_pattern(Tree), {P1, Bound, _} = vann_pattern(P, Env), E = erl_syntax:binary_generator_body(Tree), {E1, _, Free} = vann(E, Env), Tree1 = rewrite(Tree, erl_syntax:binary_generator(P1, E1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_block_expr(Tree, Env) -> Es = erl_syntax:block_expr_body(Tree), {Es1, {Bound, Free}} = vann_body(Es, Env), Tree1 = rewrite(Tree, erl_syntax:block_expr(Es1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_body_join() -> fun (T, {Env, Bound, Free}) -> {T1, Bound1, Free1} = vann(T, Env), Env1 = ordsets:union(Env, Bound1), {T1, {Env1, ordsets:union(Bound, Bound1), ordsets:union(Free, ordsets:subtract(Free1, Bound))}} end. vann_body(Ts, Env) -> {Ts1, {_, Bound, Free}} = lists:mapfoldl(vann_body_join(), {Env, [], []}, Ts), {Ts1, {Bound, Free}}. %% Macro names must be ignored even if they happen to be variables, %% lexically speaking. vann_macro(Tree, Env) -> {As, {Bound, Free}} = case erl_syntax:macro_arguments(Tree) of none -> {none, {[], []}}; As1 -> vann_list(As1, Env) end, N = erl_syntax:macro_name(Tree), Tree1 = rewrite(Tree, erl_syntax:macro(N, As)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_pattern(Tree, Env) -> case erl_syntax:type(Tree) of variable -> V = erl_syntax:variable_name(Tree), case ordsets:is_element(V, Env) of true -> %% Variable use Bound = [], Free = [V], {ann_bindings(Tree, Env, Bound, Free), Bound, Free}; false -> %% Variable binding Bound = [V], Free = [], {ann_bindings(Tree, Env, Bound, Free), Bound, Free} end; match_expr -> %% Alias pattern P = erl_syntax:match_expr_pattern(Tree), {P1, Bound1, Free1} = vann_pattern(P, Env), E = erl_syntax:match_expr_body(Tree), {E1, Bound2, Free2} = vann_pattern(E, Env), Bound = ordsets:union(Bound1, Bound2), Free = ordsets:union(Free1, Free2), Tree1 = rewrite(Tree, erl_syntax:match_expr(P1, E1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}; macro -> %% The macro name must be ignored. The arguments are treated %% as patterns. {As, {Bound, Free}} = case erl_syntax:macro_arguments(Tree) of none -> {none, {[], []}}; As1 -> vann_patterns(As1, Env) end, N = erl_syntax:macro_name(Tree), Tree1 = rewrite(Tree, erl_syntax:macro(N, As)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}; _Type -> F = vann_patterns_join(Env), {Tree1, {Bound, Free}} = mapfold_subtrees(F, {[], []}, Tree), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free} end. vann_patterns_join(Env) -> fun (T, {Bound, Free}) -> {T1, Bound1, Free1} = vann_pattern(T, Env), {T1, {ordsets:union(Bound, Bound1), ordsets:union(Free, Free1)}} end. vann_patterns(Ps, Env) -> lists:mapfoldl(vann_patterns_join(Env), {[], []}, Ps). vann_clause(C, Env) -> {Ps, {Bound1, Free1}} = vann_patterns(erl_syntax:clause_patterns(C), Env), Env1 = ordsets:union(Env, Bound1), %% Guards cannot add bindings {G1, _, Free2} = case erl_syntax:clause_guard(C) of none -> {none, [], []}; G -> vann(G, Env1) end, {Es, {Bound2, Free3}} = vann_body(erl_syntax:clause_body(C), Env1), Bound = ordsets:union(Bound1, Bound2), Free = ordsets:union(Free1, ordsets:subtract(ordsets:union(Free2, Free3), Bound1)), Tree1 = rewrite(C, erl_syntax:clause(Ps, G1, Es)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. vann_clauses_join(Env) -> fun (C, {Bound, Free}) -> {C1, Bound1, Free1} = vann_clause(C, Env), {C1, {ordsets:intersection(Bound, Bound1), ordsets:union(Free, Free1)}} end. vann_clauses([C | Cs], Env) -> {C1, Bound, Free} = vann_clause(C, Env), {Cs1, BF} = lists:mapfoldl(vann_clauses_join(Env), {Bound, Free}, Cs), {[C1 | Cs1], BF}; vann_clauses([], _Env) -> {[], {[], []}}. ann_bindings(Tree, Env, Bound, Free) -> As0 = erl_syntax:get_ann(Tree), As1 = [{env, Env}, {bound, Bound}, {free, Free} | delete_binding_anns(As0)], erl_syntax:set_ann(Tree, As1). delete_binding_anns([{env, _} | As]) -> delete_binding_anns(As); delete_binding_anns([{bound, _} | As]) -> delete_binding_anns(As); delete_binding_anns([{free, _} | As]) -> delete_binding_anns(As); delete_binding_anns([A | As]) -> [A | delete_binding_anns(As)]; delete_binding_anns([]) -> []. %% ===================================================================== %% @spec is_fail_expr(Tree::syntaxTree()) -> boolean() %% %% @doc Returns `true' if `Tree' represents an %% expression which never terminates normally. Note that the reverse %% does not apply. Currently, the detected cases are calls to %% `exit/1', `throw/1', %% `erlang:error/1' and `erlang:error/2'. %% %% @see //erts/erlang:exit/1 %% @see //erts/erlang:throw/1 %% @see //erts/erlang:error/1 %% @see //erts/erlang:error/2 -spec is_fail_expr(erl_syntax:syntaxTree()) -> boolean(). is_fail_expr(E) -> case erl_syntax:type(E) of application -> N = length(erl_syntax:application_arguments(E)), F = erl_syntax:application_operator(E), case catch {ok, analyze_function_name(F)} of syntax_error -> false; {ok, exit} when N =:= 1 -> true; {ok, throw} when N =:= 1 -> true; {ok, {erlang, exit}} when N =:= 1 -> true; {ok, {erlang, throw}} when N =:= 1 -> true; {ok, {erlang, error}} when N =:= 1 -> true; {ok, {erlang, error}} when N =:= 2 -> true; {ok, {erlang, fault}} when N =:= 1 -> true; {ok, {erlang, fault}} when N =:= 2 -> true; _ -> false end; _ -> false end. %% ===================================================================== %% @spec analyze_forms(Forms) -> [{Key, term()}] %% %% Forms = syntaxTree() | [syntaxTree()] %% Key = attributes | errors | exports | functions | imports %% | module | records | rules | warnings %% %% @doc Analyzes a sequence of "program forms". The given %% `Forms' may be a single syntax tree of type %% `form_list', or a list of "program form" syntax trees. The %% returned value is a list of pairs `{Key, Info}', where %% each value of `Key' occurs at most once in the list; the %% absence of a particular key indicates that there is no well-defined %% value for that key. %% %% Each entry in the resulting list contains the following %% corresponding information about the program forms: %%
%%
`{attributes, Attributes}'
%%
    %%
  • `Attributes = [{atom(), term()}]'
  • %%
%% `Attributes' is a list of pairs representing the %% names and corresponding values of all so-called "wild" %% attributes (as e.g. "`-compile(...)'") occurring in %% `Forms' (cf. `analyze_wild_attribute/1'). %% We do not guarantee that each name occurs at most once in the %% list. The order of listing is not defined.
%% %%
`{errors, Errors}'
%%
    %%
  • `Errors = [term()]'
  • %%
%% `Errors' is the list of error descriptors of all %% `error_marker' nodes that occur in %% `Forms'. The order of listing is not defined.
%% %%
`{exports, Exports}'
%%
    %%
  • `Exports = [FunctionName]'
  • %%
  • `FunctionName = atom() %% | {atom(), integer()} %% | {ModuleName, FunctionName}'
  • %%
  • `ModuleName = atom()'
  • %%
%% `Exports' is a list of representations of those %% function names that are listed by export declaration attributes %% in `Forms' (cf. %% `analyze_export_attribute/1'). We do not guarantee %% that each name occurs at most once in the list. The order of %% listing is not defined.
%% %%
`{functions, Functions}'
%%
    %%
  • `Functions = [{atom(), integer()}]'
  • %%
%% `Functions' is a list of the names of the functions %% that are defined in `Forms' (cf. %% `analyze_function/1'). We do not guarantee that each %% name occurs at most once in the list. The order of listing is %% not defined.
%% %%
`{imports, Imports}'
%%
    %%
  • `Imports = [{Module, Names}]'
  • %%
  • `Module = atom()'
  • %%
  • `Names = [FunctionName]'
  • %%
  • `FunctionName = atom() %% | {atom(), integer()} %% | {ModuleName, FunctionName}'
  • %%
  • `ModuleName = atom()'
  • %%
%% `Imports' is a list of pairs representing those %% module names and corresponding function names that are listed %% by import declaration attributes in `Forms' (cf. %% `analyze_import_attribute/1'), where each %% `Module' occurs at most once in %% `Imports'. We do not guarantee that each name occurs %% at most once in the lists of function names. The order of %% listing is not defined.
%% %%
`{module, ModuleName}'
%%
    %%
  • `ModuleName = atom()'
  • %%
%% `ModuleName' is the name declared by a module %% attribute in `Forms'. If no module name is defined %% in `Forms', the result will contain no entry for the %% `module' key. If multiple module name declarations %% should occur, all but the first will be ignored.
%% %%
`{records, Records}'
%%
    %%
  • `Records = [{atom(), Fields}]'
  • %%
  • `Fields = [{atom(), Default}]'
  • %%
  • `Default = none | syntaxTree()'
  • %%
%% `Records' is a list of pairs representing the names %% and corresponding field declarations of all record declaration %% attributes occurring in `Forms'. For fields declared %% without a default value, the corresponding value for %% `Default' is the atom `none' (cf. %% `analyze_record_attribute/1'). We do not guarantee %% that each record name occurs at most once in the list. The %% order of listing is not defined.
%% %%
`{rules, Rules}'
%%
    %%
  • `Rules = [{atom(), integer()}]'
  • %%
%% `Rules' is a list of the names of the rules that are %% defined in `Forms' (cf. %% `analyze_rule/1'). We do not guarantee that each %% name occurs at most once in the list. The order of listing is %% not defined.
%% %%
`{warnings, Warnings}'
%%
    %%
  • `Warnings = [term()]'
  • %%
%% `Warnings' is the list of error descriptors of all %% `warning_marker' nodes that occur in %% `Forms'. The order of listing is not defined.
%%
%% %% The evaluation throws `syntax_error' if an ill-formed %% Erlang construct is encountered. %% %% @see analyze_wild_attribute/1 %% @see analyze_export_attribute/1 %% @see analyze_import_attribute/1 %% @see analyze_record_attribute/1 %% @see analyze_function/1 %% @see analyze_rule/1 %% @see erl_syntax:error_marker_info/1 %% @see erl_syntax:warning_marker_info/1 -type key() :: 'attributes' | 'errors' | 'exports' | 'functions' | 'imports' | 'module' | 'records' | 'rules' | 'warnings'. -type info_pair() :: {key(), term()}. -spec analyze_forms(erl_syntax:forms()) -> [info_pair()]. analyze_forms(Forms) when is_list(Forms) -> finfo_to_list(lists:foldl(fun collect_form/2, new_finfo(), Forms)); analyze_forms(Forms) -> analyze_forms( erl_syntax:form_list_elements( erl_syntax:flatten_form_list(Forms))). collect_form(Node, Info) -> case analyze_form(Node) of {attribute, {Name, Data}} -> collect_attribute(Name, Data, Info); {attribute, preprocessor} -> Info; {function, Name} -> finfo_add_function(Name, Info); {rule, Name} -> finfo_add_rule(Name, Info); {error_marker, Data} -> finfo_add_error(Data, Info); {warning_marker, Data} -> finfo_add_warning(Data, Info); _ -> Info end. collect_attribute(module, M, Info) -> finfo_set_module(M, Info); collect_attribute(export, L, Info) -> finfo_add_exports(L, Info); collect_attribute(import, {M, L}, Info) -> finfo_add_imports(M, L, Info); collect_attribute(import, M, Info) -> finfo_add_module_import(M, Info); collect_attribute(file, _, Info) -> Info; collect_attribute(record, {R, L}, Info) -> finfo_add_record(R, L, Info); collect_attribute(spec, _, Info) -> Info; collect_attribute(_, {N, V}, Info) -> finfo_add_attribute(N, V, Info). %% Abstract datatype for collecting module information. -record(forms, {module = none :: 'none' | {'value', atom()}, exports = [] :: [{atom(), arity()}], module_imports = [] :: [atom()], imports = [] :: [{atom(), [{atom(), arity()}]}], attributes = [] :: [{atom(), term()}], records = [] :: [{atom(), [{atom(), field_default()}]}], errors = [] :: [term()], warnings = [] :: [term()], functions = [] :: [{atom(), arity()}], rules = [] :: [{atom(), arity()}]}). -type field_default() :: 'none' | erl_syntax:syntaxTree(). new_finfo() -> #forms{}. finfo_set_module(Name, Info) -> case Info#forms.module of none -> Info#forms{module = {value, Name}}; {value, _} -> Info end. finfo_add_exports(L, Info) -> Info#forms{exports = L ++ Info#forms.exports}. finfo_add_module_import(M, Info) -> Info#forms{module_imports = [M | Info#forms.module_imports]}. finfo_add_imports(M, L, Info) -> Es = Info#forms.imports, case lists:keyfind(M, 1, Es) of {_, L1} -> Es1 = lists:keyreplace(M, 1, Es, {M, L ++ L1}), Info#forms{imports = Es1}; false -> Info#forms{imports = [{M, L} | Es]} end. finfo_add_attribute(Name, Val, Info) -> Info#forms{attributes = [{Name, Val} | Info#forms.attributes]}. finfo_add_record(R, L, Info) -> Info#forms{records = [{R, L} | Info#forms.records]}. finfo_add_error(R, Info) -> Info#forms{errors = [R | Info#forms.errors]}. finfo_add_warning(R, Info) -> Info#forms{warnings = [R | Info#forms.warnings]}. finfo_add_function(F, Info) -> Info#forms{functions = [F | Info#forms.functions]}. finfo_add_rule(F, Info) -> Info#forms{rules = [F | Info#forms.rules]}. finfo_to_list(Info) -> [{Key, Value} || {Key, {value, Value}} <- [{module, Info#forms.module}, {exports, list_value(Info#forms.exports)}, {imports, list_value(Info#forms.imports)}, {module_imports, list_value(Info#forms.module_imports)}, {attributes, list_value(Info#forms.attributes)}, {records, list_value(Info#forms.records)}, {errors, list_value(Info#forms.errors)}, {warnings, list_value(Info#forms.warnings)}, {functions, list_value(Info#forms.functions)}, {rules, list_value(Info#forms.rules)} ]]. list_value([]) -> none; list_value(List) -> {value, List}. %% ===================================================================== %% @spec analyze_form(Node::syntaxTree()) -> {atom(), term()} | atom() %% %% @doc Analyzes a "source code form" node. If `Node' is a %% "form" type (cf. `erl_syntax:is_form/1'), the returned %% value is a tuple `{Type, Info}' where `Type' is %% the node type and `Info' depends on `Type', as %% follows: %%
%%
`{attribute, Info}'
%% %%
where `Info = analyze_attribute(Node)'.
%% %%
`{error_marker, Info}'
%% %%
where `Info = %% erl_syntax:error_marker_info(Node)'.
%% %%
`{function, Info}'
%% %%
where `Info = analyze_function(Node)'.
%% %%
`{rule, Info}'
%% %%
where `Info = analyze_rule(Node)'.
%% %%
`{warning_marker, Info}'
%% %%
where `Info = %% erl_syntax:warning_marker_info(Node)'.
%%
%% For other types of forms, only the node type is returned. %% %% The evaluation throws `syntax_error' if %% `Node' is not well-formed. %% %% @see analyze_attribute/1 %% @see analyze_function/1 %% @see analyze_rule/1 %% @see erl_syntax:is_form/1 %% @see erl_syntax:error_marker_info/1 %% @see erl_syntax:warning_marker_info/1 -spec analyze_form(erl_syntax:syntaxTree()) -> {atom(), term()} | atom(). analyze_form(Node) -> case erl_syntax:type(Node) of attribute -> {attribute, analyze_attribute(Node)}; function -> {function, analyze_function(Node)}; rule -> {rule, analyze_rule(Node)}; error_marker -> {error_marker, erl_syntax:error_marker_info(Node)}; warning_marker -> {warning_marker, erl_syntax:warning_marker_info(Node)}; _ -> case erl_syntax:is_form(Node) of true -> erl_syntax:type(Node); false -> throw(syntax_error) end end. %% ===================================================================== %% @spec analyze_attribute(Node::syntaxTree()) -> %% preprocessor | {atom(), atom()} %% %% @doc Analyzes an attribute node. If `Node' represents a %% preprocessor directive, the atom `preprocessor' is %% returned. Otherwise, if `Node' represents a module %% attribute "`-Name...'", a tuple `{Name, %% Info}' is returned, where `Info' depends on %% `Name', as follows: %%
%%
`{module, Info}'
%% %%
where `Info = %% analyze_module_attribute(Node)'.
%% %%
`{export, Info}'
%% %%
where `Info = %% analyze_export_attribute(Node)'.
%% %%
`{import, Info}'
%% %%
where `Info = %% analyze_import_attribute(Node)'.
%% %%
`{file, Info}'
%% %%
where `Info = %% analyze_file_attribute(Node)'.
%% %%
`{record, Info}'
%% %%
where `Info = %% analyze_record_attribute(Node)'.
%% %%
`{Name, Info}'
%% %%
where `{Name, Info} = %% analyze_wild_attribute(Node)'.
%%
%% The evaluation throws `syntax_error' if `Node' %% does not represent a well-formed module attribute. %% %% @see analyze_module_attribute/1 %% @see analyze_export_attribute/1 %% @see analyze_import_attribute/1 %% @see analyze_file_attribute/1 %% @see analyze_record_attribute/1 %% @see analyze_wild_attribute/1 -spec analyze_attribute(erl_syntax:syntaxTree()) -> 'preprocessor' | {atom(), term()}. % XXX: underspecified analyze_attribute(Node) -> Name = erl_syntax:attribute_name(Node), case erl_syntax:type(Name) of atom -> case erl_syntax:atom_value(Name) of define -> preprocessor; undef -> preprocessor; include -> preprocessor; include_lib -> preprocessor; ifdef -> preprocessor; ifndef -> preprocessor; else -> preprocessor; endif -> preprocessor; A -> {A, analyze_attribute(A, Node)} end; _ -> throw(syntax_error) end. analyze_attribute(module, Node) -> analyze_module_attribute(Node); analyze_attribute(export, Node) -> analyze_export_attribute(Node); analyze_attribute(import, Node) -> analyze_import_attribute(Node); analyze_attribute(file, Node) -> analyze_file_attribute(Node); analyze_attribute(record, Node) -> analyze_record_attribute(Node); analyze_attribute(define, _Node) -> define; analyze_attribute(spec, _Node) -> spec; analyze_attribute(_, Node) -> %% A "wild" attribute (such as e.g. a `compile' directive). analyze_wild_attribute(Node). %% ===================================================================== %% @spec analyze_module_attribute(Node::syntaxTree()) -> %% Name::atom() | {Name::atom(), Variables::[atom()]} %% %% @doc Returns the module name and possible parameters declared by a %% module attribute. If the attribute is a plain module declaration such %% as `-module(name)', the result is the module name. If the attribute %% is a parameterized module declaration, the result is a tuple %% containing the module name and a list of the parameter variable %% names. %% %% The evaluation throws `syntax_error' if `Node' does not represent a %% well-formed module attribute. %% %% @see analyze_attribute/1 -spec analyze_module_attribute(erl_syntax:syntaxTree()) -> atom() | {atom(), [atom()]}. analyze_module_attribute(Node) -> case erl_syntax:type(Node) of attribute -> case erl_syntax:attribute_arguments(Node) of [M] -> module_name_to_atom(M); [M, L] -> M1 = module_name_to_atom(M), L1 = analyze_variable_list(L), {M1, L1}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. analyze_variable_list(Node) -> case erl_syntax:is_proper_list(Node) of true -> [erl_syntax:variable_name(V) || V <- erl_syntax:list_elements(Node)]; false -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_export_attribute(Node::syntaxTree()) -> [FunctionName] %% %% FunctionName = atom() | {atom(), integer()} %% | {ModuleName, FunctionName} %% ModuleName = atom() %% %% @doc Returns the list of function names declared by an export %% attribute. We do not guarantee that each name occurs at most once in %% the list. The order of listing is not defined. %% %% The evaluation throws `syntax_error' if `Node' does not represent a %% well-formed export attribute. %% %% @see analyze_attribute/1 -type functionN() :: atom() | {atom(), arity()}. -type functionName() :: functionN() | {atom(), functionN()}. -spec analyze_export_attribute(erl_syntax:syntaxTree()) -> [functionName()]. analyze_export_attribute(Node) -> case erl_syntax:type(Node) of attribute -> case erl_syntax:attribute_arguments(Node) of [L] -> analyze_function_name_list(L); _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. analyze_function_name_list(Node) -> case erl_syntax:is_proper_list(Node) of true -> [analyze_function_name(F) || F <- erl_syntax:list_elements(Node)]; false -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_function_name(Node::syntaxTree()) -> FunctionName %% %% FunctionName = atom() | {atom(), integer()} %% | {ModuleName, FunctionName} %% ModuleName = atom() %% %% @doc Returns the function name represented by a syntax tree. If %% `Node' represents a function name, such as %% "`foo/1'" or "`bloggs:fred/2'", a uniform %% representation of that name is returned. Different nestings of arity %% and module name qualifiers in the syntax tree does not affect the %% result. %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed function name. -spec analyze_function_name(erl_syntax:syntaxTree()) -> functionName(). analyze_function_name(Node) -> case erl_syntax:type(Node) of atom -> erl_syntax:atom_value(Node); arity_qualifier -> A = erl_syntax:arity_qualifier_argument(Node), case erl_syntax:type(A) of integer -> F = erl_syntax:arity_qualifier_body(Node), F1 = analyze_function_name(F), append_arity(erl_syntax:integer_value(A), F1); _ -> throw(syntax_error) end; module_qualifier -> M = erl_syntax:module_qualifier_argument(Node), case erl_syntax:type(M) of atom -> F = erl_syntax:module_qualifier_body(Node), F1 = analyze_function_name(F), {erl_syntax:atom_value(M), F1}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. append_arity(A, {Module, Name}) -> {Module, append_arity(A, Name)}; append_arity(A, Name) when is_atom(Name) -> {Name, A}; append_arity(A, A) -> A; append_arity(_A, Name) -> Name. % quietly drop extra arity in case of conflict %% ===================================================================== %% @spec analyze_import_attribute(Node::syntaxTree()) -> %% {atom(), [FunctionName]} | atom() %% %% FunctionName = atom() | {atom(), integer()} %% | {ModuleName, FunctionName} %% ModuleName = atom() %% %% @doc Returns the module name and (if present) list of function names %% declared by an import attribute. The returned value is an atom %% `Module' or a pair `{Module, Names}', where %% `Names' is a list of function names declared as imported %% from the module named by `Module'. We do not guarantee %% that each name occurs at most once in `Names'. The order %% of listing is not defined. %% %% The evaluation throws `syntax_error' if `Node' does not represent a %% well-formed import attribute. %% %% @see analyze_attribute/1 -spec analyze_import_attribute(erl_syntax:syntaxTree()) -> {atom(), [functionName()]} | atom(). analyze_import_attribute(Node) -> case erl_syntax:type(Node) of attribute -> case erl_syntax:attribute_arguments(Node) of [M] -> module_name_to_atom(M); [M, L] -> M1 = module_name_to_atom(M), L1 = analyze_function_name_list(L), {M1, L1}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_wild_attribute(Node::syntaxTree()) -> {atom(), term()} %% %% @doc Returns the name and value of a "wild" attribute. The result is %% the pair `{Name, Value}', if `Node' represents "`-Name(Value)'". %% %% Note that no checking is done whether `Name' is a %% reserved attribute name such as `module' or %% `export': it is assumed that the attribute is "wild". %% %% The evaluation throws `syntax_error' if `Node' does not represent a %% well-formed wild attribute. %% %% @see analyze_attribute/1 -spec analyze_wild_attribute(erl_syntax:syntaxTree()) -> {atom(), term()}. analyze_wild_attribute(Node) -> case erl_syntax:type(Node) of attribute -> N = erl_syntax:attribute_name(Node), case erl_syntax:type(N) of atom -> case erl_syntax:attribute_arguments(Node) of [V] -> case catch {ok, erl_syntax:concrete(V)} of {ok, Val} -> {erl_syntax:atom_value(N), Val}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_record_attribute(Node::syntaxTree()) -> %% {atom(), Fields} %% %% Fields = [{atom(), none | syntaxTree()}] %% %% @doc Returns the name and the list of fields of a record declaration %% attribute. The result is a pair `{Name, Fields}', if %% `Node' represents "`-record(Name, {...}).'", %% where `Fields' is a list of pairs `{Label, %% Default}' for each field "`Label'" or "`Label = %% Default'" in the declaration, listed in left-to-right %% order. If the field has no default-value declaration, the value for %% `Default' will be the atom `none'. We do not %% guarantee that each label occurs at most one in the list. %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed record declaration %% attribute. %% %% @see analyze_attribute/1 %% @see analyze_record_field/1 -type fields() :: [{atom(), 'none' | erl_syntax:syntaxTree()}]. -spec analyze_record_attribute(erl_syntax:syntaxTree()) -> {atom(), fields()}. analyze_record_attribute(Node) -> case erl_syntax:type(Node) of attribute -> case erl_syntax:attribute_arguments(Node) of [R, T] -> case erl_syntax:type(R) of atom -> Es = analyze_record_attribute_tuple(T), {erl_syntax:atom_value(R), Es}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. analyze_record_attribute_tuple(Node) -> case erl_syntax:type(Node) of tuple -> [analyze_record_field(F) || F <- erl_syntax:tuple_elements(Node)]; _ -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_record_expr(Node::syntaxTree()) -> %% {atom(), Info} | atom() %% %% Info = {atom(), [{atom(), Value}]} | {atom(), atom()} | atom() %% Value = none | syntaxTree() %% %% @doc Returns the record name and field name/names of a record %% expression. If `Node' has type `record_expr', %% `record_index_expr' or `record_access', a pair %% `{Type, Info}' is returned, otherwise an atom %% `Type' is returned. `Type' is the node type of %% `Node', and `Info' depends on %% `Type', as follows: %%
%%
`record_expr':
%%
`{atom(), [{atom(), Value}]}'
%%
`record_access':
%%
`{atom(), atom()} | atom()'
%%
`record_index_expr':
%%
`{atom(), atom()}'
%%
%% %% For a `record_expr' node, `Info' represents %% the record name and the list of descriptors for the involved fields, %% listed in the order they appear. (See %% `analyze_record_field/1' for details on the field %% descriptors). For a `record_access' node, %% `Info' represents the record name and the field name (or %% if the record name is not included, only the field name; this is %% allowed only in Mnemosyne-query syntax). For a %% `record_index_expr' node, `Info' represents the %% record name and the name field name. %% %% The evaluation throws `syntax_error' if %% `Node' represents a record expression that is not %% well-formed. %% %% @see analyze_record_attribute/1 %% @see analyze_record_field/1 -type info() :: {atom(), [{atom(), 'none' | erl_syntax:syntaxTree()}]} | {atom(), atom()} | atom(). -spec analyze_record_expr(erl_syntax:syntaxTree()) -> {atom(), info()} | atom(). analyze_record_expr(Node) -> case erl_syntax:type(Node) of record_expr -> A = erl_syntax:record_expr_type(Node), case erl_syntax:type(A) of atom -> Fs = [analyze_record_field(F) || F <- erl_syntax:record_expr_fields(Node)], {record_expr, {erl_syntax:atom_value(A), Fs}}; _ -> throw(syntax_error) end; record_access -> F = erl_syntax:record_access_field(Node), case erl_syntax:type(F) of atom -> case erl_syntax:record_access_type(Node) of none -> {record_access, erl_syntax:atom_value(F)}; A -> case erl_syntax:type(A) of atom -> {record_access, {erl_syntax:atom_value(A), erl_syntax:atom_value(F)}}; _ -> throw(syntax_error) end end; _ -> throw(syntax_error) end; record_index_expr -> F = erl_syntax:record_index_expr_field(Node), case erl_syntax:type(F) of atom -> A = erl_syntax:record_index_expr_type(Node), case erl_syntax:type(A) of atom -> {record_index_expr, {erl_syntax:atom_value(A), erl_syntax:atom_value(F)}}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end; Type -> Type end. %% ===================================================================== %% @spec analyze_record_field(Node::syntaxTree()) -> {atom(), Value} %% %% Value = none | syntaxTree() %% %% @doc Returns the label and value-expression of a record field %% specifier. The result is a pair `{Label, Value}', if %% `Node' represents "`Label = Value'" or %% "`Label'", where in the first case, `Value' is %% a syntax tree, and in the second case `Value' is %% `none'. %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed record field %% specifier. %% %% @see analyze_record_attribute/1 %% @see analyze_record_expr/1 -spec analyze_record_field(erl_syntax:syntaxTree()) -> {atom(), 'none' | erl_syntax:syntaxTree()}. analyze_record_field(Node) -> case erl_syntax:type(Node) of record_field -> A = erl_syntax:record_field_name(Node), case erl_syntax:type(A) of atom -> T = erl_syntax:record_field_value(Node), {erl_syntax:atom_value(A), T}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_file_attribute(Node::syntaxTree()) -> %% {string(), integer()} %% %% @doc Returns the file name and line number of a `file' %% attribute. The result is the pair `{File, Line}' if %% `Node' represents "`-file(File, Line).'". %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed `file' %% attribute. %% %% @see analyze_attribute/1 -spec analyze_file_attribute(erl_syntax:syntaxTree()) -> {string(), integer()}. analyze_file_attribute(Node) -> case erl_syntax:type(Node) of attribute -> case erl_syntax:attribute_arguments(Node) of [F, N] -> case (erl_syntax:type(F) =:= string) and (erl_syntax:type(N) =:= integer) of true -> {erl_syntax:string_value(F), erl_syntax:integer_value(N)}; false -> throw(syntax_error) end; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_function(Node::syntaxTree()) -> {atom(), integer()} %% %% @doc Returns the name and arity of a function definition. The result %% is a pair `{Name, A}' if `Node' represents a %% function definition "`Name(P_1, ..., P_A) -> %% ...'". %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed function %% definition. %% %% @see analyze_rule/1 -spec analyze_function(erl_syntax:syntaxTree()) -> {atom(), arity()}. analyze_function(Node) -> case erl_syntax:type(Node) of function -> N = erl_syntax:function_name(Node), case erl_syntax:type(N) of atom -> {erl_syntax:atom_value(N), erl_syntax:function_arity(Node)}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_rule(Node::syntaxTree()) -> {atom(), integer()} %% %% @doc Returns the name and arity of a Mnemosyne rule. The result is a %% pair `{Name, A}' if `Node' represents a rule %% "`Name(P_1, ..., P_A) :- ...'". %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed Mnemosyne %% rule. %% %% @see analyze_function/1 -spec analyze_rule(erl_syntax:syntaxTree()) -> {atom(), arity()}. analyze_rule(Node) -> case erl_syntax:type(Node) of rule -> N = erl_syntax:rule_name(Node), case erl_syntax:type(N) of atom -> {erl_syntax:atom_value(N), erl_syntax:rule_arity(Node)}; _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_implicit_fun(Node::syntaxTree()) -> FunctionName %% %% FunctionName = atom() | {atom(), integer()} %% | {ModuleName, FunctionName} %% ModuleName = atom() %% %% @doc Returns the name of an implicit fun expression "`fun %% F'". The result is a representation of the function %% name `F'. (Cf. `analyze_function_name/1'.) %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed implicit fun. %% %% @see analyze_function_name/1 -spec analyze_implicit_fun(erl_syntax:syntaxTree()) -> functionName(). analyze_implicit_fun(Node) -> case erl_syntax:type(Node) of implicit_fun -> analyze_function_name(erl_syntax:implicit_fun_name(Node)); _ -> throw(syntax_error) end. %% ===================================================================== %% @spec analyze_application(Node::syntaxTree()) -> FunctionName | Arity %% %% FunctionName = {atom(), Arity} %% | {ModuleName, FunctionName} %% Arity = integer() %% ModuleName = atom() %% %% @doc Returns the name of a called function. The result is a %% representation of the name of the applied function `F/A', %% if `Node' represents a function application %% "`F(X_1, ..., X_A)'". If the %% function is not explicitly named (i.e., `F' is given by %% some expression), only the arity `A' is returned. %% %% The evaluation throws `syntax_error' if `Node' does not represent a %% well-formed application expression. %% %% @see analyze_function_name/1 -type appFunName() :: {atom(), arity()} | {atom(), {atom(), arity()}}. -spec analyze_application(erl_syntax:syntaxTree()) -> appFunName() | arity(). analyze_application(Node) -> case erl_syntax:type(Node) of application -> A = length(erl_syntax:application_arguments(Node)), F = erl_syntax:application_operator(Node), case catch {ok, analyze_function_name(F)} of syntax_error -> A; {ok, N} -> append_arity(A, N); _ -> throw(syntax_error) end; _ -> throw(syntax_error) end. %% ===================================================================== %% @spec function_name_expansions(Names::[Name]) -> [{ShortName, Name}] %% %% Name = ShortName | {atom(), Name} %% ShortName = atom() | {atom(), integer()} %% %% @doc Creates a mapping from corresponding short names to full %% function names. Names are represented by nested tuples of atoms and %% integers (cf. `analyze_function_name/1'). The result is a %% list containing a pair `{ShortName, Name}' for each %% element `Name' in the given list, where the corresponding %% `ShortName' is the rightmost-innermost part of %% `Name'. The list thus represents a finite mapping from %% unqualified names to the corresponding qualified names. %% %% Note: the resulting list can contain more than one tuple %% `{ShortName, Name}' for the same `ShortName', %% possibly with different values for `Name', depending on %% the given list. %% %% @see analyze_function_name/1 -type shortname() :: atom() | {atom(), arity()}. -type name() :: shortname() | {atom(), shortname()}. -spec function_name_expansions([name()]) -> [{shortname(), name()}]. function_name_expansions(Fs) -> function_name_expansions(Fs, []). function_name_expansions([F | Fs], Ack) -> function_name_expansions(Fs, function_name_expansions(F, F, Ack)); function_name_expansions([], Ack) -> Ack. function_name_expansions({A, N}, Name, Ack) when is_integer(N) -> [{{A, N}, Name} | Ack]; function_name_expansions({_, N}, Name, Ack) -> function_name_expansions(N, Name, Ack); function_name_expansions(A, Name, Ack) -> [{A, Name} | Ack]. %% ===================================================================== %% @spec strip_comments(Tree::syntaxTree()) -> syntaxTree() %% %% @doc Removes all comments from all nodes of a syntax tree. All other %% attributes (such as position information) remain unchanged. %% Standalone comments in form lists are removed; any other standalone %% comments are changed into null-comments (no text, no indentation). -spec strip_comments(erl_syntax:syntaxTree()) -> erl_syntax:syntaxTree(). strip_comments(Tree) -> map(fun strip_comments_1/1, Tree). strip_comments_1(T) -> case erl_syntax:type(T) of form_list -> Es = erl_syntax:form_list_elements(T), Es1 = [E || E <- Es, erl_syntax:type(E) /= comment], T1 = erl_syntax:copy_attrs(T, erl_syntax:form_list(Es1)), erl_syntax:remove_comments(T1); comment -> erl_syntax:comment([]); _ -> erl_syntax:remove_comments(T) end. %% ===================================================================== %% @spec to_comment(Tree) -> syntaxTree() %% @equiv to_comment(Tree, "% ") -spec to_comment(erl_syntax:syntaxTree()) -> erl_syntax:syntaxTree(). to_comment(Tree) -> to_comment(Tree, "% "). %% ===================================================================== %% @spec to_comment(Tree::syntaxTree(), Prefix::string()) -> %% syntaxTree() %% %% @doc Equivalent to `to_comment(Tree, Prefix, F)' for a %% default formatting function `F'. The default %% `F' simply calls `erl_prettypr:format/1'. %% %% @see to_comment/3 %% @see erl_prettypr:format/1 -spec to_comment(erl_syntax:syntaxTree(), string()) -> erl_syntax:syntaxTree(). to_comment(Tree, Prefix) -> F = fun (T) -> erl_prettypr:format(T) end, to_comment(Tree, Prefix, F). %% ===================================================================== %% @spec to_comment(Tree::syntaxTree(), Prefix::string(), Printer) -> %% syntaxTree() %% %% Printer = (syntaxTree()) -> string() %% %% @doc Transforms a syntax tree into an abstract comment. The lines of %% the comment contain the text for `Node', as produced by %% the given `Printer' function. Each line of the comment is %% prefixed by the string `Prefix' (this does not include the %% initial "`%'" character of the comment line). %% %% For example, the result of %% `to_comment(erl_syntax:abstract([a,b,c]))' represents %%
%%         %% [a,b,c]
%% (cf. `to_comment/1'). %% %% Note: the text returned by the formatting function will be split %% automatically into separate comment lines at each line break. No %% extra work is needed. %% %% @see to_comment/1 %% @see to_comment/2 -spec to_comment(erl_syntax:syntaxTree(), string(), fun((erl_syntax:syntaxTree()) -> string())) -> erl_syntax:syntaxTree(). to_comment(Tree, Prefix, F) -> erl_syntax:comment(split_lines(F(Tree), Prefix)). %% ===================================================================== %% @spec limit(Tree, Depth) -> syntaxTree() %% %% @doc Equivalent to `limit(Tree, Depth, Text)' using the %% text `"..."' as default replacement. %% %% @see limit/3 %% @see erl_syntax:text/1 -spec limit(erl_syntax:syntaxTree(), integer()) -> erl_syntax:syntaxTree(). limit(Tree, Depth) -> limit(Tree, Depth, erl_syntax:text("...")). %% ===================================================================== %% @spec limit(Tree::syntaxTree(), Depth::integer(), %% Node::syntaxTree()) -> syntaxTree() %% %% @doc Limits a syntax tree to a specified depth. Replaces all non-leaf %% subtrees in `Tree' at the given `Depth' by %% `Node'. If `Depth' is negative, the result is %% always `Node', even if `Tree' has no subtrees. %% %% When a group of subtrees (as e.g., the argument list of an %% `application' node) is at the specified depth, and there %% are two or more subtrees in the group, these will be collectively %% replaced by `Node' even if they are leaf nodes. Groups of %% subtrees that are above the specified depth will be limited in size, %% as if each subsequent tree in the group were one level deeper than %% the previous. E.g., if `Tree' represents a list of %% integers "`[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]'", the result %% of `limit(Tree, 5)' will represent `[1, 2, 3, 4, %% ...]'. %% %% The resulting syntax tree is typically only useful for %% pretty-printing or similar visual formatting. %% %% @see limit/2 -spec limit(erl_syntax:syntaxTree(), integer(), erl_syntax:syntaxTree()) -> erl_syntax:syntaxTree(). limit(_Tree, Depth, Node) when Depth < 0 -> Node; limit(Tree, Depth, Node) -> limit_1(Tree, Depth, Node). limit_1(Tree, Depth, Node) -> %% Depth is nonnegative here. case erl_syntax:subtrees(Tree) of [] -> if Depth > 0 -> Tree; true -> case is_simple_leaf(Tree) of true -> Tree; false -> Node end end; Gs -> if Depth > 1 -> Gs1 = [[limit_1(T, Depth - 1, Node) || T <- limit_list(G, Depth, Node)] || G <- Gs], rewrite(Tree, erl_syntax:make_tree(erl_syntax:type(Tree), Gs1)); Depth =:= 0 -> %% Depth is zero, and this is not a leaf node %% so we always replace it. Node; true -> %% Depth is 1, so all subtrees are to be cut. %% This is done groupwise. Gs1 = [cut_group(G, Node) || G <- Gs], rewrite(Tree, erl_syntax:make_tree(erl_syntax:type(Tree), Gs1)) end end. cut_group([], _Node) -> []; cut_group([T], Node) -> %% Only if the group contains a single subtree do we try to %% preserve it if suitable. [limit_1(T, 0, Node)]; cut_group(_Ts, Node) -> [Node]. is_simple_leaf(Tree) -> case erl_syntax:type(Tree) of atom -> true; char -> true; float -> true; integer -> true; nil -> true; operator -> true; tuple -> true; underscore -> true; variable -> true; _ -> false end. %% If list has more than N elements, take the N - 1 first and %% append Node; otherwise return list as is. limit_list(Ts, N, Node) -> if length(Ts) > N -> limit_list_1(Ts, N - 1, Node); true -> Ts end. limit_list_1([T | Ts], N, Node) -> if N > 0 -> [T | limit_list_1(Ts, N - 1, Node)]; true -> [Node] end; limit_list_1([], _N, _Node) -> []. %% ===================================================================== %% Utility functions rewrite(Tree, Tree1) -> erl_syntax:copy_attrs(Tree, Tree1). module_name_to_atom(M) -> case erl_syntax:type(M) of atom -> erl_syntax:atom_value(M); qualified_name -> list_to_atom(packages:concat( [erl_syntax:atom_value(A) || A <- erl_syntax:qualified_name_segments(M)]) ); _ -> throw(syntax_error) end. %% This splits lines at line terminators and expands tab characters to %% spaces. The width of a tab is assumed to be 8. % split_lines(Cs) -> % split_lines(Cs, ""). split_lines(Cs, Prefix) -> split_lines(Cs, Prefix, 0). split_lines(Cs, Prefix, N) -> lists:reverse(split_lines(Cs, N, [], [], Prefix)). split_lines([$\r, $\n | Cs], _N, Cs1, Ls, Prefix) -> split_lines_1(Cs, Cs1, Ls, Prefix); split_lines([$\r | Cs], _N, Cs1, Ls, Prefix) -> split_lines_1(Cs, Cs1, Ls, Prefix); split_lines([$\n | Cs], _N, Cs1, Ls, Prefix) -> split_lines_1(Cs, Cs1, Ls, Prefix); split_lines([$\t | Cs], N, Cs1, Ls, Prefix) -> split_lines(Cs, 0, push(8 - (N rem 8), $\040, Cs1), Ls, Prefix); split_lines([C | Cs], N, Cs1, Ls, Prefix) -> split_lines(Cs, N + 1, [C | Cs1], Ls, Prefix); split_lines([], _, [], Ls, _) -> Ls; split_lines([], _N, Cs, Ls, Prefix) -> [Prefix ++ lists:reverse(Cs) | Ls]. split_lines_1(Cs, Cs1, Ls, Prefix) -> split_lines(Cs, 0, [], [Prefix ++ lists:reverse(Cs1) | Ls], Prefix). push(N, C, Cs) when N > 0 -> push(N - 1, C, [C | Cs]); push(0, _, Cs) -> Cs.