aboutsummaryrefslogtreecommitdiffstats
path: root/lib/syntax_tools/src/erl_syntax_lib.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/syntax_tools/src/erl_syntax_lib.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/syntax_tools/src/erl_syntax_lib.erl')
-rw-r--r--lib/syntax_tools/src/erl_syntax_lib.erl2168
1 files changed, 2168 insertions, 0 deletions
diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl
new file mode 100644
index 0000000000..ccbf864c2a
--- /dev/null
+++ b/lib/syntax_tools/src/erl_syntax_lib.erl
@@ -0,0 +1,2168 @@
+%% =====================================================================
+%% 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 <[email protected]>
+%% @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]).
+
+
+%% =====================================================================
+%% @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
+
+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
+
+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
+
+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
+
+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
+
+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
+
+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
+
+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.
+
+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
+
+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
+
+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
+
+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) ->
+ max(sets:size(S) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE).
+
+max(X, Y) when X > Y -> X;
+max(_, Y) -> Y.
+
+%% 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
+
+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
+
+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:
+%% <ul>
+%% <li>`{env, Vars}', representing the input environment
+%% of the subtree.</li>
+%%
+%% <li>`{bound, Vars}', representing the variables that
+%% are bound in the subtree.</li>
+%%
+%% <li>`{free, Vars}', representing the free variables in
+%% the subtree.</li>
+%% </ul>
+%% `Bindings' and `Vars' are ordered-set lists
+%% (cf. module `ordsets') of atoms representing variable
+%% names.
+%%
+%% @see annotate_bindings/1
+%% @see //stdlib/ordsets
+
+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
+
+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()) -> bool()
+%%
+%% @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
+
+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:
+%% <dl>
+%% <dt>`{attributes, Attributes}'</dt>
+%% <dd><ul>
+%% <li>`Attributes = [{atom(), term()}]'</li>
+%% </ul>
+%% `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.</dd>
+%%
+%% <dt>`{errors, Errors}'</dt>
+%% <dd><ul>
+%% <li>`Errors = [term()]'</li>
+%% </ul>
+%% `Errors' is the list of error descriptors of all
+%% `error_marker' nodes that occur in
+%% `Forms'. The order of listing is not defined.</dd>
+%%
+%% <dt>`{exports, Exports}'</dt>
+%% <dd><ul>
+%% <li>`Exports = [FunctionName]'</li>
+%% <li>`FunctionName = atom()
+%% | {atom(), integer()}
+%% | {ModuleName, FunctionName}'</li>
+%% <li>`ModuleName = atom()'</li>
+%% </ul>
+%% `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.</dd>
+%%
+%% <dt>`{functions, Functions}'</dt>
+%% <dd><ul>
+%% <li>`Functions = [{atom(), integer()}]'</li>
+%% </ul>
+%% `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.</dd>
+%%
+%% <dt>`{imports, Imports}'</dt>
+%% <dd><ul>
+%% <li>`Imports = [{Module, Names}]'</li>
+%% <li>`Module = atom()'</li>
+%% <li>`Names = [FunctionName]'</li>
+%% <li>`FunctionName = atom()
+%% | {atom(), integer()}
+%% | {ModuleName, FunctionName}'</li>
+%% <li>`ModuleName = atom()'</li>
+%% </ul>
+%% `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.</dd>
+%%
+%% <dt>`{module, ModuleName}'</dt>
+%% <dd><ul>
+%% <li>`ModuleName = atom()'</li>
+%% </ul>
+%% `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.</dd>
+%%
+%% <dt>`{records, Records}'</dt>
+%% <dd><ul>
+%% <li>`Records = [{atom(), Fields}]'</li>
+%% <li>`Fields = [{atom(), Default}]'</li>
+%% <li>`Default = none | syntaxTree()'</li>
+%% </ul>
+%% `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.</dd>
+%%
+%% <dt>`{rules, Rules}'</dt>
+%% <dd><ul>
+%% <li>`Rules = [{atom(), integer()}]'</li>
+%% </ul>
+%% `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.</dd>
+%%
+%% <dt>`{warnings, Warnings}'</dt>
+%% <dd><ul>
+%% <li>`Warnings = [term()]'</li>
+%% </ul>
+%% `Warnings' is the list of error descriptors of all
+%% `warning_marker' nodes that occur in
+%% `Forms'. The order of listing is not defined.</dd>
+%% </dl>
+%%
+%% 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
+
+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, exports, module_imports, imports, attributes,
+ records, errors, warnings, functions, rules}).
+
+new_finfo() ->
+ #forms{module = none,
+ exports = [],
+ module_imports = [],
+ imports = [],
+ attributes = [],
+ records = [],
+ errors = [],
+ warnings = [],
+ functions = [],
+ rules = []
+ }.
+
+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:
+%% <dl>
+%% <dt>`{attribute, Info}'</dt>
+%%
+%% <dd>where `Info = analyze_attribute(Node)'.</dd>
+%%
+%% <dt>`{error_marker, Info}'</dt>
+%%
+%% <dd>where `Info =
+%% erl_syntax:error_marker_info(Node)'.</dd>
+%%
+%% <dt>`{function, Info}'</dt>
+%%
+%% <dd>where `Info = analyze_function(Node)'.</dd>
+%%
+%% <dt>`{rule, Info}'</dt>
+%%
+%% <dd>where `Info = analyze_rule(Node)'.</dd>
+%%
+%% <dt>`{warning_marker, Info}'</dt>
+%%
+%% <dd>where `Info =
+%% erl_syntax:warning_marker_info(Node)'.</dd>
+%% </dl>
+%% 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
+
+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 "`-<em>Name</em>...'", a tuple `{Name,
+%% Info}' is returned, where `Info' depends on
+%% `Name', as follows:
+%% <dl>
+%% <dt>`{module, Info}'</dt>
+%%
+%% <dd>where `Info =
+%% analyze_module_attribute(Node)'.</dd>
+%%
+%% <dt>`{export, Info}'</dt>
+%%
+%% <dd>where `Info =
+%% analyze_export_attribute(Node)'.</dd>
+%%
+%% <dt>`{import, Info}'</dt>
+%%
+%% <dd>where `Info =
+%% analyze_import_attribute(Node)'.</dd>
+%%
+%% <dt>`{file, Info}'</dt>
+%%
+%% <dd>where `Info =
+%% analyze_file_attribute(Node)'.</dd>
+%%
+%% <dt>`{record, Info}'</dt>
+%%
+%% <dd>where `Info =
+%% analyze_record_attribute(Node)'.</dd>
+%%
+%% <dt>`{Name, Info}'</dt>
+%%
+%% <dd>where `{Name, Info} =
+%% analyze_wild_attribute(Node)'.</dd>
+%% </dl>
+%% 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
+
+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
+
+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
+
+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.
+
+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
+
+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
+
+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 =
+%% <em>Default</em>'" 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
+
+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:
+%% <dl>
+%% <dt>`record_expr':</dt>
+%% <dd>`{atom(), [{atom(), Value}]}'</dd>
+%% <dt>`record_access':</dt>
+%% <dd>`{atom(), atom()} | atom()'</dd>
+%% <dt>`record_index_expr':</dt>
+%% <dd>`{atom(), atom()}'</dd>
+%% </dl>
+%%
+%% 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
+
+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 = <em>Value</em>'" 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
+
+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
+
+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(<em>P_1</em>, ..., <em>P_A</em>) ->
+%% ...'".
+%%
+%% The evaluation throws `syntax_error' if
+%% `Node' does not represent a well-formed function
+%% definition.
+%%
+%% @see analyze_rule/1
+
+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(<em>P_1</em>, ..., <em>P_A</em>) :- ...'".
+%%
+%% The evaluation throws `syntax_error' if
+%% `Node' does not represent a well-formed Mnemosyne
+%% rule.
+%%
+%% @see analyze_function/1
+
+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
+%% <em>F</em>'". 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
+
+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
+%% "`<em>F</em>(<em>X_1</em>, ..., <em>X_A</em>)'". 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
+
+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
+
+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).
+
+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, "% ")
+
+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
+
+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
+%% <pre>
+%% %% [a,b,c]</pre>
+%% (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
+
+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
+
+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
+
+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.
+