%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% @copyright 1999-2002 Richard Carlsson.
%% @author Richard Carlsson <carlsson.richard@gmail.com>
%% @doc Basic functions on Core Erlang abstract syntax trees.
%%
%% <p>Syntax trees are defined in the module {@link cerl}.</p>
%%
%% @type cerl() = cerl:cerl()

-module(cerl_trees).
-moduledoc """
Basic functions on Core Erlang abstract syntax trees.

> #### Note {: .info }
>
> The public interface of the Erlang compiler can be found in
> module `m:compile`.
>
> This module is an internal part of the compiler. Its API is not guaranteed
> to remain compatible between releases.

Syntax trees are defined in the module `m:cerl`.
""".

-export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2, 
	 map/2, mapfold/3, mapfold/4, next_free_variable_name/1,
         size/1, variables/1]).

-import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3,
	       ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4,
	       ann_c_case/3, ann_c_catch/2, ann_c_clause/4,
	       ann_c_cons_skel/3, ann_c_fun/3, ann_c_let/4,
	       ann_c_letrec/3, ann_c_module/5, ann_c_primop/3,
	       ann_c_receive/4, ann_c_seq/3, ann_c_try/6,
	       ann_c_tuple_skel/2, ann_c_values/2, apply_args/1,
	       apply_op/1, binary_segments/1, bitstr_val/1,
	       bitstr_size/1, bitstr_unit/1, bitstr_type/1,
	       bitstr_flags/1, call_args/1, call_module/1, call_name/1,
	       case_arg/1, case_clauses/1, catch_body/1, clause_body/1,
	       clause_guard/1, clause_pats/1, clause_vars/1, concrete/1,
	       cons_hd/1, cons_tl/1, fun_body/1, fun_vars/1, get_ann/1,
	       let_arg/1, let_body/1, let_vars/1, letrec_body/1,
	       letrec_defs/1, letrec_vars/1, module_attrs/1,
	       module_defs/1, module_exports/1, module_name/1,
	       module_vars/1, primop_args/1, primop_name/1,
	       receive_action/1, receive_clauses/1, receive_timeout/1,
	       seq_arg/1, seq_body/1, set_ann/2, subtrees/1, try_arg/1,
	       try_body/1, try_vars/1, try_evars/1, try_handler/1,
	       tuple_es/1, type/1, update_c_alias/3, update_c_apply/3,
	       update_c_binary/2, update_c_bitstr/6, update_c_call/4,
	       update_c_case/3, update_c_catch/2, update_c_clause/4,
	       update_c_cons/3, update_c_cons_skel/3, update_c_fun/3,
	       update_c_let/4, update_c_letrec/3, update_c_module/5,
	       update_c_primop/3, update_c_receive/4, update_c_seq/3,
	       update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2,
	       update_c_values/2, values_es/1, var_name/1,

	       map_arg/1, map_es/1,
	       ann_c_map/3,
	       update_c_map/3,
	       is_c_map_pattern/1, ann_c_map_pattern/2,
	       map_pair_key/1,map_pair_val/1,map_pair_op/1,
	       ann_c_map_pair/4,
	       update_c_map_pair/4
	   ]).

-type cerl() :: cerl:cerl().

%% ---------------------------------------------------------------------

-doc """
Returns the length of the longest path in the tree.

A leaf node has depth zero, the tree representing "`{foo, bar}`" has
depth one, and so on.
""".
-spec depth(Tree :: cerl()) ->
          non_neg_integer().

depth(T) ->
    case subtrees(T) of
	[] ->
	    0;
	Gs ->
	    1 + lists:foldl(fun (G, A) -> erlang:max(depth_1(G), A) end, 0, Gs)
    end.

depth_1(Ts) ->
    lists:foldl(fun (T, A) -> erlang:max(depth(T), A) end, 0, Ts).



-doc "Returns the number of nodes in `Tree`.".
-spec size(Tree :: cerl()) -> non_neg_integer().

size(T) ->
    fold(fun (_, S) -> S + 1 end, 0, T).


%% ---------------------------------------------------------------------

-doc """
Maps a function onto the nodes of a tree.

This replaces each node in the tree by the result of applying the
given function on the original node, bottom-up.

_See also: _`mapfold/3`.
""".
-spec map(Function :: fun((cerl()) -> cerl()), Tree :: cerl()) -> cerl().

map(F, T) ->
    F(map_1(F, T)).

map_1(F, T) ->
    case type(T) of
 	literal ->
	    case concrete(T) of
		[_ | _] ->
		    update_c_cons(T, map(F, cons_hd(T)),
				  map(F, cons_tl(T)));
		V when tuple_size(V) > 0 ->
		    update_c_tuple(T, map_list(F, tuple_es(T)));
		_ ->
		    T
	    end;
 	var ->
 	    T;
	values ->
 	    update_c_values(T, map_list(F, values_es(T)));
	cons ->
	    update_c_cons_skel(T, map(F, cons_hd(T)),
			       map(F, cons_tl(T)));
 	tuple ->
	    update_c_tuple_skel(T, map_list(F, tuple_es(T)));
 	map ->
	    update_c_map(T, map(F, map_arg(T)), map_list(F, map_es(T)));
	map_pair ->
	    update_c_map_pair(T, map(F, map_pair_op(T)),
                                 map(F, map_pair_key(T)),
                                 map(F, map_pair_val(T)));
 	'let' ->
	    update_c_let(T, map_list(F, let_vars(T)),
			 map(F, let_arg(T)),
			 map(F, let_body(T)));
	seq ->
 	    update_c_seq(T, map(F, seq_arg(T)),
			 map(F, seq_body(T)));
 	apply ->
	    update_c_apply(T, map(F, apply_op(T)),
			   map_list(F, apply_args(T)));
 	call ->
 	    update_c_call(T, map(F, call_module(T)),
			  map(F, call_name(T)),
			  map_list(F, call_args(T)));
 	primop ->
	    update_c_primop(T, map(F, primop_name(T)),
			    map_list(F, primop_args(T)));
 	'case' ->
 	    update_c_case(T, map(F, case_arg(T)),
			  map_list(F, case_clauses(T)));
 	clause ->
 	    update_c_clause(T, map_list(F, clause_pats(T)),
			    map(F, clause_guard(T)),
			    map(F, clause_body(T)));
 	alias ->
	    update_c_alias(T, map(F, alias_var(T)),
			   map(F, alias_pat(T)));
 	'fun' ->
	    update_c_fun(T, map_list(F, fun_vars(T)),
			 map(F, fun_body(T)));
 	'receive' ->
	    update_c_receive(T, map_list(F, receive_clauses(T)),
			     map(F, receive_timeout(T)),
			     map(F, receive_action(T)));
 	'try' ->
 	    update_c_try(T, map(F, try_arg(T)),
			 map_list(F, try_vars(T)),
			 map(F, try_body(T)),
			 map_list(F, try_evars(T)),
			 map(F, try_handler(T)));
 	'catch' ->
	    update_c_catch(T, map(F, catch_body(T)));
	binary ->
	    update_c_binary(T, map_list(F, binary_segments(T)));
	bitstr ->
	    update_c_bitstr(T, map(F, bitstr_val(T)),
			    map(F, bitstr_size(T)),
			    map(F, bitstr_unit(T)),
			    map(F, bitstr_type(T)),
			    map(F, bitstr_flags(T)));
	letrec ->
	    update_c_letrec(T, map_pairs(F, letrec_defs(T)),
			    map(F, letrec_body(T)));
	module ->
	    update_c_module(T, map(F, module_name(T)),
			    map_list(F, module_exports(T)),
			    map_pairs(F, module_attrs(T)),
			    map_pairs(F, module_defs(T)));
        opaque ->
            T
    end.

map_list(F, [T | Ts]) ->
    [map(F, T) | map_list(F, Ts)];
map_list(_, []) ->
    [].

map_pairs(F, [{T1, T2} | Ps]) ->
    [{map(F, T1), map(F, T2)} | map_pairs(F, Ps)];
map_pairs(_, []) ->
    [].


-doc """
Does a fold operation over the nodes of the tree.

The result is the value of `Function(X1, Function(X2, ... Function(Xn,
Unit) ... ))`, where `X1, ..., Xn` are the nodes of `Tree` in a
post-order traversal.

_See also: _`mapfold/3`.
""".
-spec fold(Function :: fun((cerl(), term()) -> term()),
           Unit :: term(), Term :: cerl()) -> term().

fold(F, S, T) ->
    F(T, fold_1(F, S, T)).

fold_1(F, S, T) ->
    case type(T) of
 	literal ->
	    case concrete(T) of
		[_ | _] ->
		    fold(F, fold(F, S, cons_hd(T)), cons_tl(T));
		V when tuple_size(V) > 0 ->
		    fold_list(F, S, tuple_es(T));
		_ ->
		    S
	    end;
 	var ->
 	    S;
	values ->
 	    fold_list(F, S, values_es(T));
	cons ->
	    fold(F, fold(F, S, cons_hd(T)), cons_tl(T));
	tuple ->
	    fold_list(F, S, tuple_es(T));
	map ->
	    fold_list(F, S, map_es(T));
	map_pair ->
	    fold(F,
		fold(F,
		    fold(F, S, map_pair_op(T)),
		    map_pair_key(T)),
		map_pair_val(T));
 	'let' ->
	    fold(F, fold(F, fold_list(F, S, let_vars(T)),
			 let_arg(T)),
		 let_body(T));
	seq ->
	    fold(F, fold(F, S, seq_arg(T)), seq_body(T));
	apply ->
	    fold_list(F, fold(F, S, apply_op(T)), apply_args(T));
 	call ->
	    fold_list(F, fold(F, fold(F, S, call_module(T)),
			      call_name(T)),
		      call_args(T));
 	primop ->
	    fold_list(F, fold(F, S, primop_name(T)), primop_args(T));
 	'case' ->
	    fold_list(F, fold(F, S, case_arg(T)), case_clauses(T));
 	clause ->
	    fold(F, fold(F, fold_list(F, S, clause_pats(T)),
			 clause_guard(T)),
		 clause_body(T));
 	alias ->
	    fold(F, fold(F, S, alias_var(T)), alias_pat(T));
 	'fun' ->
	    fold(F, fold_list(F, S, fun_vars(T)), fun_body(T));
 	'receive' ->
	    fold(F, fold(F, fold_list(F, S, receive_clauses(T)),
			 receive_timeout(T)),
		 receive_action(T));
 	'try' ->
	    fold(F, fold_list(F, fold(F, fold_list(F, fold(F, S, try_arg(T)),
						   try_vars(T)),
				      try_body(T)),
			      try_evars(T)),
		 try_handler(T));
 	'catch' ->
	    fold(F, S, catch_body(T));
	binary ->
	    fold_list(F, S, binary_segments(T));
	bitstr ->
	    fold(F,
		 fold(F,
		      fold(F,
			   fold(F,
				fold(F, S, bitstr_val(T)),
				bitstr_size(T)),
			   bitstr_unit(T)),
		      bitstr_type(T)),
		 bitstr_flags(T));
	letrec ->
	    fold(F, fold_pairs(F, S, letrec_defs(T)), letrec_body(T));
	module ->
            fold_pairs(F,
		       fold_pairs(F,
                                  fold_list(F,
					    fold(F, S, module_name(T)),
					    module_exports(T)),
				  module_attrs(T)),
		       module_defs(T));
        opaque ->
            S
    end.

fold_list(F, S, [T | Ts]) ->
    fold_list(F, fold(F, S, T), Ts);
fold_list(_, S, []) ->
    S.

fold_pairs(F, S, [{T1, T2} | Ps]) ->
    fold_pairs(F, fold(F, fold(F, S, T1), T2), Ps);
fold_pairs(_, S, []) ->
    S.


-doc """
Does a combined map/fold operation on the nodes of the tree.

This is similar to [`map/2`](`map/2`), but also propagates a value
from each application of `Function` to the next, starting with the
given value `Initial`, while doing a post-order traversal of the tree,
much like [`fold/3`](`fold/3`).

This is equivalent to `mapfold/4` with an identity function as the
pre-operation.

_See also:_ `fold/3`, `map/2`, `mapfold/4`.
""".
-spec mapfold(Function :: fun((cerl(), term()) -> {cerl(), term()}),
	      Initial :: term(),
              Tree :: cerl()) -> {cerl(), term()}.

mapfold(F, S0, T) ->
  mapfold(fun(T0, A) -> {T0, A} end, F, S0, T).


-doc """
Does a combined map/fold operation on the nodes of the tree.

It begins by calling `Pre` on the tree, using the `Initial`
value. `Pre` must either return a tree with an updated accumulator or
the atom `skip`.

If a tree is returned, this function deconstructs the top node of the returned
tree and recurses on the children, using the returned value as the new initial
and carrying the returned values from one call to the next. Finally it
reassembles the top node from the children, calls `Post` on it and returns the
result.

If `skip` is returned, it returns the tree and accumulator as is.
""".
-spec mapfold(Pre :: fun((cerl(), term()) -> {cerl(), term()} | skip),
              Post :: fun((cerl(), term()) -> {cerl(), term()}),
	      Initial :: term(),
              Tree :: cerl()) ->
          {cerl(), term()}.

mapfold(Pre, Post, S00, T0) ->
    case Pre(T0, S00) of
	{T, S0} ->
	    case type(T) of
		literal ->
		    case concrete(T) of
			[_ | _] ->
			    {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)),
			    {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)),
			    Post(update_c_cons(T, T1, T2), S2);
			V when tuple_size(V) > 0 ->
			    {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)),
			    Post(update_c_tuple(T, Ts), S1);
			_ ->
			    Post(T, S0)
		    end;
		var ->
		    Post(T, S0);
		values ->
		    {Ts, S1} = mapfold_list(Pre, Post, S0, values_es(T)),
		    Post(update_c_values(T, Ts), S1);
		cons ->
		    {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)),
		    {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)),
		    Post(update_c_cons_skel(T, T1, T2), S2);
		tuple ->
		    {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)),
		    Post(update_c_tuple_skel(T, Ts), S1);
		map ->
		    {M , S1} = mapfold(Pre, Post, S0, map_arg(T)),
		    {Ts, S2} = mapfold_list(Pre, Post, S1, map_es(T)),
		    Post(update_c_map(T, M, Ts), S2);
		map_pair ->
		    {Op,  S1} = mapfold(Pre, Post, S0, map_pair_op(T)),
		    {Key, S2} = mapfold(Pre, Post, S1, map_pair_key(T)),
		    {Val, S3} = mapfold(Pre, Post, S2, map_pair_val(T)),
		    Post(update_c_map_pair(T,Op,Key,Val), S3);
		'let' ->
		    {Vs, S1} = mapfold_list(Pre, Post, S0, let_vars(T)),
		    {A, S2} = mapfold(Pre, Post, S1, let_arg(T)),
		    {B, S3} = mapfold(Pre, Post, S2, let_body(T)),
		    Post(update_c_let(T, Vs, A, B), S3);
		seq ->
		    {A, S1} = mapfold(Pre, Post, S0, seq_arg(T)),
		    {B, S2} = mapfold(Pre, Post, S1, seq_body(T)),
		    Post(update_c_seq(T, A, B), S2);
		apply ->
		    {E, S1} = mapfold(Pre, Post, S0, apply_op(T)),
		    {As, S2} = mapfold_list(Pre, Post, S1, apply_args(T)),
		    Post(update_c_apply(T, E, As), S2);
		call ->
		    {M, S1} = mapfold(Pre, Post, S0, call_module(T)),
		    {N, S2} = mapfold(Pre, Post, S1, call_name(T)),
		    {As, S3} = mapfold_list(Pre, Post, S2, call_args(T)),
		    Post(update_c_call(T, M, N, As), S3);
		primop ->
		    {N, S1} = mapfold(Pre, Post, S0, primop_name(T)),
		    {As, S2} = mapfold_list(Pre, Post, S1, primop_args(T)),
		    Post(update_c_primop(T, N, As), S2);
		'case' ->
		    {A, S1} = mapfold(Pre, Post, S0, case_arg(T)),
		    {Cs, S2} = mapfold_list(Pre, Post, S1, case_clauses(T)),
		    Post(update_c_case(T, A, Cs), S2);
		clause ->
		    {Ps, S1} = mapfold_list(Pre, Post, S0, clause_pats(T)),
		    {G, S2} = mapfold(Pre, Post, S1, clause_guard(T)),
		    {B, S3} = mapfold(Pre, Post, S2, clause_body(T)),
		    Post(update_c_clause(T, Ps, G, B), S3);
		alias ->
		    {V, S1} = mapfold(Pre, Post, S0, alias_var(T)),
		    {P, S2} = mapfold(Pre, Post, S1, alias_pat(T)),
		    Post(update_c_alias(T, V, P), S2);
		'fun' ->
		    {Vs, S1} = mapfold_list(Pre, Post, S0, fun_vars(T)),
		    {B, S2} = mapfold(Pre, Post, S1, fun_body(T)),
		    Post(update_c_fun(T, Vs, B), S2);
		'receive' ->
		    {Cs, S1} = mapfold_list(Pre, Post, S0, receive_clauses(T)),
		    {E, S2} = mapfold(Pre, Post, S1, receive_timeout(T)),
		    {A, S3} = mapfold(Pre, Post, S2, receive_action(T)),
		    Post(update_c_receive(T, Cs, E, A), S3);
		'try' ->
		    {E, S1} = mapfold(Pre, Post, S0, try_arg(T)),
		    {Vs, S2} = mapfold_list(Pre, Post, S1, try_vars(T)),
		    {B, S3} = mapfold(Pre, Post, S2, try_body(T)),
		    {Evs, S4} = mapfold_list(Pre, Post, S3, try_evars(T)),
		    {H, S5} = mapfold(Pre, Post, S4, try_handler(T)),
		    Post(update_c_try(T, E, Vs, B, Evs, H), S5);
		'catch' ->
		    {B, S1} = mapfold(Pre, Post, S0, catch_body(T)),
		    Post(update_c_catch(T, B), S1);
		binary ->
		    {Ds, S1} = mapfold_list(Pre, Post, S0, binary_segments(T)),
		    Post(update_c_binary(T, Ds), S1);
		bitstr ->
		    {Val, S1} = mapfold(Pre, Post, S0, bitstr_val(T)),
		    {Size, S2} = mapfold(Pre, Post, S1, bitstr_size(T)),
		    {Unit, S3} = mapfold(Pre, Post, S2, bitstr_unit(T)),
		    {Type, S4} = mapfold(Pre, Post, S3, bitstr_type(T)),
		    {Flags, S5} = mapfold(Pre, Post, S4, bitstr_flags(T)),
		    Post(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5);
		letrec ->
		    {Ds, S1} = mapfold_pairs(Pre, Post, S0, letrec_defs(T)),
		    {B, S2} = mapfold(Pre, Post, S1, letrec_body(T)),
		    Post(update_c_letrec(T, Ds, B), S2);
		module ->
		    {N, S1} = mapfold(Pre, Post, S0, module_name(T)),
		    {Es, S2} = mapfold_list(Pre, Post, S1, module_exports(T)),
		    {As, S3} = mapfold_pairs(Pre, Post, S2, module_attrs(T)),
		    {Ds, S4} = mapfold_pairs(Pre, Post, S3, module_defs(T)),
		    Post(update_c_module(T, N, Es, As, Ds), S4);
                opaque ->
                    Post(T, S0)
	    end;
	skip ->
	    {T0, S00}
    end.

mapfold_list(Pre, Post, S0, [T | Ts]) ->
    {T1, S1} = mapfold(Pre, Post, S0, T),
    {Ts1, S2} = mapfold_list(Pre, Post, S1, Ts),
    {[T1 | Ts1], S2};
mapfold_list(_, _, S, []) ->
    {[], S}.

mapfold_pairs(Pre, Post, S0, [{T1, T2} | Ps]) ->
    {T3, S1} = mapfold(Pre, Post, S0, T1),
    {T4, S2} = mapfold(Pre, Post, S1, T2),
    {Ps1, S3} = mapfold_pairs(Pre, Post, S2, Ps),
    {[{T3, T4} | Ps1], S3};
mapfold_pairs(_, _, S, []) ->
    {[], S}.


-doc """
Returns an ordered-set list of the names of all variables in the syntax tree
(including function-name variables.)

An exception is thrown if `Tree` does not represent a well-formed Core
Erlang syntax tree.

_See also: _`free_variables/1`, `next_free_variable_name/1`.
""".
-spec variables(Tree :: cerl()) -> [cerl:var_name()].

variables(T) ->
    variables(T, false).


-doc """
Like [`variables/1`](`variables/1`), but only includes variables that are free
in the tree.

_See also: _`next_free_variable_name/1`, `variables/1`.
""".
-spec free_variables(Tree :: cerl()) -> [cerl:var_name()].

free_variables(T) ->
    variables(T, true).


%% This is not exported

variables(T, S) ->
    case type(T) of
	literal ->
	    [];
	var ->
	    [var_name(T)];
	values ->
	    vars_in_list(values_es(T), S);
	cons ->
	    ordsets:union(variables(cons_hd(T), S),
			  variables(cons_tl(T), S));
	tuple ->
	    vars_in_list(tuple_es(T), S);
	map ->
	    vars_in_list([map_arg(T)|map_es(T)], S);
	map_pair ->
	    vars_in_list([map_pair_op(T),map_pair_key(T),map_pair_val(T)], S);
	'let' ->
	    Vs = variables(let_body(T), S),
	    Vs1 = var_list_names(let_vars(T)),
	    Vs2 = case S of
		      true ->
			  ordsets:subtract(Vs, Vs1);
		      false ->
			  ordsets:union(Vs, Vs1)
		  end,
	    ordsets:union(variables(let_arg(T), S), Vs2);
	seq ->
	    ordsets:union(variables(seq_arg(T), S),
			  variables(seq_body(T), S));
	apply ->
	    ordsets:union(
	      variables(apply_op(T), S),
	      vars_in_list(apply_args(T), S));
	call ->
	    ordsets:union(variables(call_module(T), S),
			  ordsets:union(
			    variables(call_name(T), S),
			    vars_in_list(call_args(T), S)));
	primop ->
	    vars_in_list(primop_args(T), S);
	'case' ->
	    ordsets:union(variables(case_arg(T), S),
			  vars_in_list(case_clauses(T), S));
	clause ->
	    Vs = ordsets:union(variables(clause_guard(T), S),
			       variables(clause_body(T), S)),
	    Vs1 = vars_in_list(clause_pats(T), S),
	    case S of
		true ->
		    ordsets:subtract(Vs, Vs1);
		false ->
		    ordsets:union(Vs, Vs1)
	    end;
	alias ->
	    ordsets:add_element(var_name(alias_var(T)),
				variables(alias_pat(T)));
	'fun' ->
	    Vs = variables(fun_body(T), S),
	    Vs1 = var_list_names(fun_vars(T)),
	    case S of
		true ->
		    ordsets:subtract(Vs, Vs1);
		false ->
		    ordsets:union(Vs, Vs1)
	    end;
	'receive' ->
	    ordsets:union(
	      vars_in_list(receive_clauses(T), S),
	      ordsets:union(variables(receive_timeout(T), S),
			    variables(receive_action(T), S)));
	'try' ->
	    Vs = variables(try_body(T), S),
	    Vs1 = var_list_names(try_vars(T)),
	    Vs2 = case S of
		      true ->
			  ordsets:subtract(Vs, Vs1);
		      false ->
			  ordsets:union(Vs, Vs1)
		  end,
	    Vs3 = variables(try_handler(T), S),
	    Vs4 = var_list_names(try_evars(T)),
	    Vs5 = case S of
		      true ->
			  ordsets:subtract(Vs3, Vs4);
		      false ->
			  ordsets:union(Vs3, Vs4)
		  end,
	    ordsets:union(variables(try_arg(T), S),
			  ordsets:union(Vs2, Vs5));
	'catch' ->
	    variables(catch_body(T), S);
	binary ->
	    vars_in_list(binary_segments(T), S);
	bitstr ->
	    ordsets:union(variables(bitstr_val(T), S),
			  variables(bitstr_size(T), S));
	letrec ->
	    Vs = vars_in_defs(letrec_defs(T), S),
	    Vs1 = ordsets:union(variables(letrec_body(T), S), Vs),
	    Vs2 = var_list_names(letrec_vars(T)),
	    case S of
		true ->
		    ordsets:subtract(Vs1, Vs2);
		false ->
		    ordsets:union(Vs1, Vs2)
	    end;
	module ->
	    Vs = vars_in_defs(module_defs(T), S),
	    Vs1 = ordsets:union(vars_in_list(module_exports(T), S), Vs),
	    Vs2 = var_list_names(module_vars(T)),
	    case S of
		true ->
		    ordsets:subtract(Vs1, Vs2);
		false ->
		    ordsets:union(Vs1, Vs2)
	    end;
        opaque ->
            []
    end.

vars_in_list(Ts, S) ->
    vars_in_list(Ts, S, []).

vars_in_list([T | Ts], S, A) ->
    vars_in_list(Ts, S, ordsets:union(variables(T, S), A));
vars_in_list([], _, A) ->
    A.

%% Note that this function only visits the right-hand side of function
%% definitions.

vars_in_defs(Ds, S) ->
    vars_in_defs(Ds, S, []).

vars_in_defs([{_, Post} | Ds], S, A) ->
    vars_in_defs(Ds, S, ordsets:union(variables(Post, S), A));
vars_in_defs([], _, A) ->
    A.

%% This amounts to insertion sort. Since the lists are generally short,
%% it is hardly worthwhile to use an asymptotically better sort.

var_list_names(Vs) ->
    var_list_names(Vs, []).

var_list_names([V | Vs], A) ->
    var_list_names(Vs, ordsets:add_element(var_name(V), A));
var_list_names([], A) ->
    A.

%% ---------------------------------------------------------------------

-doc """
Returns a integer variable name higher than any other integer variable name in
the syntax tree.

An exception is thrown if `Tree` does not represent a well-formed Core
Erlang syntax tree.

_See also: _`free_variables/1`, `variables/1`.
""".
-spec next_free_variable_name(Tree :: cerl()) -> integer().

next_free_variable_name(T) ->
    1 + next_free(T, -1).

next_free(T, Max) ->
    case type(T) of
        literal ->
            Max;
        var ->
            case var_name(T) of
                Int when is_integer(Int) ->
                    max(Int, Max);
                _ ->
                    Max
            end;
        values ->
            next_free_in_list(values_es(T), Max);
        cons ->
            next_free(cons_hd(T), next_free(cons_tl(T), Max));
        tuple ->
            next_free_in_list(tuple_es(T), Max);
        map ->
            next_free_in_list([map_arg(T)|map_es(T)], Max);
        map_pair ->
            next_free_in_list([map_pair_op(T),map_pair_key(T),
                               map_pair_val(T)], Max);
        'let' ->
            Max1 = next_free(let_body(T), Max),
            Max2 = next_free_in_list(let_vars(T), Max1),
            next_free(let_arg(T), Max2);
        seq ->
            next_free(seq_arg(T),
                      next_free(seq_body(T), Max));
        apply ->
            next_free(apply_op(T),
                      next_free_in_list(apply_args(T), Max));
        call ->
            next_free(call_module(T),
                      next_free(call_name(T),
                                next_free_in_list(
                                  call_args(T), Max)));
        primop ->
            next_free_in_list(primop_args(T), Max);
        'case' ->
            next_free(case_arg(T),
                      next_free_in_list(case_clauses(T), Max));
        clause ->
            Max1 = next_free(clause_guard(T),
                             next_free(clause_body(T), Max)),
            next_free_in_list(clause_pats(T), Max1);
        alias ->
            next_free(alias_var(T),
                      next_free(alias_pat(T), Max));
        'fun' ->
            next_free(fun_body(T),
                      next_free_in_list(fun_vars(T), Max));
        'receive' ->
            Max1 = next_free_in_list(receive_clauses(T),
                                     next_free(receive_timeout(T), Max)),
            next_free(receive_action(T), Max1);
        'try' ->
            Max1 = next_free(try_body(T), Max),
            Max2 = next_free_in_list(try_vars(T), Max1),
            Max3 = next_free(try_handler(T), Max2),
            Max4 = next_free_in_list(try_evars(T), Max3),
            next_free(try_arg(T), Max4);
        'catch' ->
            next_free(catch_body(T), Max);
        binary ->
            next_free_in_list(binary_segments(T), Max);
        bitstr ->
            next_free(bitstr_val(T), next_free(bitstr_size(T), Max));
        letrec ->
            Max1 = next_free_in_defs(letrec_defs(T), Max),
            Max2 = next_free(letrec_body(T), Max1),
            next_free_in_list(letrec_vars(T), Max2);
        module ->
            next_free_in_defs(module_defs(T), Max);
        opaque ->
            Max
    end.

next_free_in_list([H | T], Max) ->
    next_free_in_list(T, next_free(H, Max));
next_free_in_list([], Max) ->
    Max.

next_free_in_defs([{_, Post} | Ds], Max) ->
    next_free_in_defs(Ds, next_free(Post, Max));
next_free_in_defs([], Max) ->
    Max.

%% ---------------------------------------------------------------------

%% label(Tree::cerl()) -> {cerl(), integer()}
%%
%% @equiv label(Tree, 0)

-doc "Equivalent to [label(Tree, 0)](`label/2`).".
-spec label(cerl()) -> {cerl(), integer()}.

label(T) ->
    label(T, 0).

-doc """
Labels each expression in the tree.

A term `{label, L}` is prefixed to the annotation list of each
expression node, where L is a unique number for every node, except for
variables (and function name variables) which get the same label if
they represent the same variable. Constant literal nodes are not
labeled.

The returned value is a tuple `{NewTree, Max}`, where `NewTree` is the labeled
tree and `Max` is 1 plus the largest label value used. All previous annotation
terms on the form `{label, X}` are deleted.

The values of L used in the tree is a dense range from `N` to `Max - 1`, where
`N =< Max =< N + size(Tree)`. Note that it is possible that no labels are used
at all, i.e., `N = Max`.

Note: All instances of free variables will be given distinct labels.

_See also: _`label/1`, `size/1`.
""".
-spec label(Tree :: cerl(), N :: integer()) -> {cerl(), integer()}.

label(T, N) ->
    label(T, N, #{}).

label(T, N, Env) ->
    case type(T) of
 	literal ->
	    %% Constant literals are not labeled.
	    {T, N};
	var ->
            VarName = var_name(T),
            {As, N1} =
                case Env of
                    #{VarName := L} ->
		        {A, _} = label_ann(T, L),
		        {A, N};
                    #{} ->
		        label_ann(T, N)
                end,
	    {set_ann(T, As), N1};
	values ->
	    {Ts, N1} = label_list(values_es(T), N, Env),
	    {As, N2} = label_ann(T, N1),
	    {ann_c_values(As, Ts), N2};
	cons ->
	    {T1, N1} = label(cons_hd(T), N, Env),
	    {T2, N2} = label(cons_tl(T), N1, Env),
	    {As, N3} = label_ann(T, N2),
	    {ann_c_cons_skel(As, T1, T2), N3};
 	tuple ->
	    {Ts, N1} = label_list(tuple_es(T), N, Env),
	    {As, N2} = label_ann(T, N1),
	    {ann_c_tuple_skel(As, Ts), N2};
 	map ->
	    case is_c_map_pattern(T) of
		false ->
		    {M,  N1} = label(map_arg(T), N, Env),
		    {Ts, N2} = label_list(map_es(T), N1, Env),
		    {As, N3} = label_ann(T, N2),
		    {ann_c_map(As, M, Ts), N3};
		true ->
		    {Ts, N1} = label_list(map_es(T), N, Env),
		    {As, N2} = label_ann(T, N1),
		    {ann_c_map_pattern(As, Ts), N2}
	    end;
	map_pair ->
	    {Op,  N1} = label(map_pair_op(T), N, Env),
	    {Key, N2} = label(map_pair_key(T), N1, Env),
	    {Val, N3} = label(map_pair_val(T), N2, Env),
	    {As,  N4} = label_ann(T, N3),
	    {ann_c_map_pair(As,Op,Key,Val), N4};
 	'let' ->
	    {A, N1} = label(let_arg(T), N, Env),
	    {Vs, N2, Env1} = label_vars(let_vars(T), N1, Env),
	    {B, N3} = label(let_body(T), N2, Env1),
	    {As, N4} = label_ann(T, N3),
	    {ann_c_let(As, Vs, A, B), N4};
	seq ->
	    {A, N1} = label(seq_arg(T), N, Env),
	    {B, N2} = label(seq_body(T), N1, Env),
	    {As, N3} = label_ann(T, N2),
 	    {ann_c_seq(As, A, B), N3};
 	apply ->
	    {E, N1} = label(apply_op(T), N, Env),
	    {Es, N2} = label_list(apply_args(T), N1, Env),
	    {As, N3} = label_ann(T, N2),
	    {ann_c_apply(As, E, Es), N3};
 	call ->
	    {M, N1} = label(call_module(T), N, Env),
	    {F, N2} = label(call_name(T), N1, Env),
	    {Es, N3} = label_list(call_args(T), N2, Env),
	    {As, N4} = label_ann(T, N3),
 	    {ann_c_call(As, M, F, Es), N4};
 	primop ->
	    {F, N1} = label(primop_name(T), N, Env),
	    {Es, N2} = label_list(primop_args(T), N1, Env),
	    {As, N3} = label_ann(T, N2),
	    {ann_c_primop(As, F, Es), N3};
 	'case' ->
	    {A, N1} = label(case_arg(T), N, Env),
	    {Cs, N2} = label_list(case_clauses(T), N1, Env),
	    {As, N3} = label_ann(T, N2),
 	    {ann_c_case(As, A, Cs), N3};
 	clause ->
	    {_, N1, Env1} = label_vars(clause_vars(T), N, Env),
	    {Ps, N2} = label_list(clause_pats(T), N1, Env1),
	    {G, N3} = label(clause_guard(T), N2, Env1),
	    {B, N4} = label(clause_body(T), N3, Env1),
	    {As, N5} = label_ann(T, N4),
	    {ann_c_clause(As, Ps, G, B), N5};
 	alias ->
	    {V, N1} = label(alias_var(T), N, Env),
	    {P, N2} = label(alias_pat(T), N1, Env),
	    {As, N3} = label_ann(T, N2),
	    {ann_c_alias(As, V, P), N3};
 	'fun' ->
	    {Vs, N1, Env1} = label_vars(fun_vars(T), N, Env),
	    {B, N2} = label(fun_body(T), N1, Env1),
	    {As, N3} = label_ann(T, N2),
	    {ann_c_fun(As, Vs, B), N3};
 	'receive' ->
	    {Cs, N1} = label_list(receive_clauses(T), N, Env),
	    {E, N2} = label(receive_timeout(T), N1, Env),
	    {A, N3} = label(receive_action(T), N2, Env),
	    {As, N4} = label_ann(T, N3),
	    {ann_c_receive(As, Cs, E, A), N4};
 	'try' ->
	    {E, N1} = label(try_arg(T), N, Env),
	    {Vs, N2, Env1} = label_vars(try_vars(T), N1, Env),
	    {B, N3} = label(try_body(T), N2, Env1),
	    {Evs, N4, Env2} = label_vars(try_evars(T), N3, Env),
	    {H, N5} = label(try_handler(T), N4, Env2),
	    {As, N6} = label_ann(T, N5),
	    {ann_c_try(As, E, Vs, B, Evs, H), N6};
 	'catch' ->
	    {B, N1} = label(catch_body(T), N, Env),
	    {As, N2} = label_ann(T, N1),
	    {ann_c_catch(As, B), N2};
	binary ->
	    {Ds, N1} = label_list(binary_segments(T), N, Env),
	    {As, N2} = label_ann(T, N1),
	    {ann_c_binary(As, Ds), N2};
	bitstr ->
	    {Val, N1} = label(bitstr_val(T), N, Env),
	    {Size, N2} = label(bitstr_size(T), N1, Env),
	    {Unit, N3} = label(bitstr_unit(T), N2, Env),
	    {Type, N4} = label(bitstr_type(T), N3, Env),
	    {Flags, N5} = label(bitstr_flags(T), N4, Env),
	    {As, N6} = label_ann(T, N5),
	    {ann_c_bitstr(As, Val, Size, Unit, Type, Flags), N6};
	letrec ->
	    {_, N1, Env1} = label_vars(letrec_vars(T), N, Env),
	    {Ds, N2} = label_defs(letrec_defs(T), N1, Env1),
	    {B, N3} = label(letrec_body(T), N2, Env1),
	    {As, N4} = label_ann(T, N3),
	    {ann_c_letrec(As, Ds, B), N4};
	module ->
	    %% The module name is not labeled.
	    {_, N1, Env1} = label_vars(module_vars(T), N, Env),
	    {Ts, N2} = label_defs(module_attrs(T), N1, Env1),
	    {Ds, N3} = label_defs(module_defs(T), N2, Env1),
	    {Es, N4} = label_list(module_exports(T), N3, Env1),
	    {As, N5} = label_ann(T, N4),
	    {ann_c_module(As, module_name(T), Es, Ts, Ds), N5};
        opaque ->
	    %% Not labeled.
	    {T, N}
    end.

label_list([T | Ts], N, Env) ->
    {T1, N1} = label(T, N, Env),
    {Ts1, N2} = label_list(Ts, N1, Env),
    {[T1 | Ts1], N2};
label_list([], N, _Env) ->
    {[], N}.

label_vars([T | Ts], N, Env) ->
    Env1 = Env#{var_name(T) => N},
    {As, N1} = label_ann(T, N),
    T1 = set_ann(T, As),
    {Ts1, N2, Env2} = label_vars(Ts, N1, Env1),
    {[T1 | Ts1], N2, Env2};
label_vars([], N, Env) ->
    {[], N, Env}.

label_defs([{F, T} | Ds], N, Env) ->
    {F1, N1} = label(F, N, Env),
    {T1, N2} = label(T, N1, Env),
    {Ds1, N3} = label_defs(Ds, N2, Env),
    {[{F1, T1} | Ds1], N3};
label_defs([], N, _Env) ->
    {[], N}.

label_ann(T, N) ->
    {[{label, N} | filter_labels(get_ann(T))], N + 1}.

filter_labels([{label, _} | As]) ->
    filter_labels(As);
filter_labels([A | As]) ->
    [A | filter_labels(As)];
filter_labels([]) ->
    [].

-doc """
Retrieves the label for `Tree`.

An exception is thrown if `Tree` does not have a label, or if `Tree`
does not represent a well-formed Core Erlang syntax tree.
""".

-spec get_label(Tree :: cerl()) -> 'top' | integer().

get_label(T) ->
    case get_ann(T) of
	[{label, L} | _] -> L;
	_ -> throw({missing_label, T})
    end.
