diff options
Diffstat (limited to 'lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl')
| -rw-r--r-- | lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl | 801 |
1 files changed, 0 insertions, 801 deletions
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl deleted file mode 100644 index 50384a6ff8..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl +++ /dev/null @@ -1,801 +0,0 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% The Initial Developer of the Original Code is Richard Carlsson. -%% Copyright (C) 1999-2002 Richard Carlsson. -%% Portions created by Ericsson are Copyright 2001, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id: cerl_trees.erl,v 1.2 2010/06/07 06:32:39 kostis Exp $ - -%% @doc Basic functions on Core Erlang abstract syntax trees. -%% -%% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> -%% -%% @type cerl() = cerl:cerl() - --module(cerl_trees). - --export([depth/1, fold/3, free_variables/1, label/1, label/2, map/2, - mapfold/3, 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]). - - -%% --------------------------------------------------------------------- - -%% @spec depth(Tree::cerl) -> integer() -%% -%% @doc Returns the length of the longest path in the tree. A leaf -%% node has depth zero, the tree representing "<code>{foo, -%% bar}</code>" has depth one, etc. - -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). - -%% max(X, Y) when X > Y -> X; -%% max(_, Y) -> Y. - - -%% @spec size(Tree::cerl()) -> integer() -%% -%% @doc Returns the number of nodes in <code>Tree</code>. - -size(T) -> - fold(fun (_, S) -> S + 1 end, 0, T). - - -%% --------------------------------------------------------------------- - -%% @spec map(Function, Tree::cerl()) -> cerl() -%% -%% Function = (cerl()) -> cerl() -%% -%% @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 mapfold/3 - -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))); - '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))) - 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(_, []) -> - []. - - -%% @spec fold(Function, Unit::term(), Tree::cerl()) -> term() -%% -%% Function = (cerl(), term()) -> term() -%% -%% @doc Does a fold operation over the nodes of the tree. The result -%% is the value of <code>Function(X1, Function(X2, ... Function(Xn, -%% Unit) ... ))</code>, where <code>X1, ..., Xn</code> are the nodes -%% of <code>Tree</code> in a post-order traversal. -%% -%% @see mapfold/3 - -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)); - '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)) - 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. - - -%% @spec mapfold(Function, Initial::term(), Tree::cerl()) -> -%% {cerl(), term()} -%% -%% Function = (cerl(), term()) -> {cerl(), term()} -%% -%% @doc Does a combined map/fold operation on the nodes of the -%% tree. This is similar to <code>map/2</code>, but also propagates a -%% value from each application of <code>Function</code> to the next, -%% starting with the given value <code>Initial</code>, while doing a -%% post-order traversal of the tree, much like <code>fold/3</code>. -%% -%% @see map/2 -%% @see fold/3 - -mapfold(F, S0, T) -> - case type(T) of - literal -> - case concrete(T) of - [_ | _] -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons(T, T1, T2), S2); - V when tuple_size(V) > 0 -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple(T, Ts), S1); - _ -> - F(T, S0) - end; - var -> - F(T, S0); - values -> - {Ts, S1} = mapfold_list(F, S0, values_es(T)), - F(update_c_values(T, Ts), S1); - cons -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons_skel(T, T1, T2), S2); - tuple -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple_skel(T, Ts), S1); - 'let' -> - {Vs, S1} = mapfold_list(F, S0, let_vars(T)), - {A, S2} = mapfold(F, S1, let_arg(T)), - {B, S3} = mapfold(F, S2, let_body(T)), - F(update_c_let(T, Vs, A, B), S3); - seq -> - {A, S1} = mapfold(F, S0, seq_arg(T)), - {B, S2} = mapfold(F, S1, seq_body(T)), - F(update_c_seq(T, A, B), S2); - apply -> - {E, S1} = mapfold(F, S0, apply_op(T)), - {As, S2} = mapfold_list(F, S1, apply_args(T)), - F(update_c_apply(T, E, As), S2); - call -> - {M, S1} = mapfold(F, S0, call_module(T)), - {N, S2} = mapfold(F, S1, call_name(T)), - {As, S3} = mapfold_list(F, S2, call_args(T)), - F(update_c_call(T, M, N, As), S3); - primop -> - {N, S1} = mapfold(F, S0, primop_name(T)), - {As, S2} = mapfold_list(F, S1, primop_args(T)), - F(update_c_primop(T, N, As), S2); - 'case' -> - {A, S1} = mapfold(F, S0, case_arg(T)), - {Cs, S2} = mapfold_list(F, S1, case_clauses(T)), - F(update_c_case(T, A, Cs), S2); - clause -> - {Ps, S1} = mapfold_list(F, S0, clause_pats(T)), - {G, S2} = mapfold(F, S1, clause_guard(T)), - {B, S3} = mapfold(F, S2, clause_body(T)), - F(update_c_clause(T, Ps, G, B), S3); - alias -> - {V, S1} = mapfold(F, S0, alias_var(T)), - {P, S2} = mapfold(F, S1, alias_pat(T)), - F(update_c_alias(T, V, P), S2); - 'fun' -> - {Vs, S1} = mapfold_list(F, S0, fun_vars(T)), - {B, S2} = mapfold(F, S1, fun_body(T)), - F(update_c_fun(T, Vs, B), S2); - 'receive' -> - {Cs, S1} = mapfold_list(F, S0, receive_clauses(T)), - {E, S2} = mapfold(F, S1, receive_timeout(T)), - {A, S3} = mapfold(F, S2, receive_action(T)), - F(update_c_receive(T, Cs, E, A), S3); - 'try' -> - {E, S1} = mapfold(F, S0, try_arg(T)), - {Vs, S2} = mapfold_list(F, S1, try_vars(T)), - {B, S3} = mapfold(F, S2, try_body(T)), - {Evs, S4} = mapfold_list(F, S3, try_evars(T)), - {H, S5} = mapfold(F, S4, try_handler(T)), - F(update_c_try(T, E, Vs, B, Evs, H), S5); - 'catch' -> - {B, S1} = mapfold(F, S0, catch_body(T)), - F(update_c_catch(T, B), S1); - binary -> - {Ds, S1} = mapfold_list(F, S0, binary_segments(T)), - F(update_c_binary(T, Ds), S1); - bitstr -> - {Val, S1} = mapfold(F, S0, bitstr_val(T)), - {Size, S2} = mapfold(F, S1, bitstr_size(T)), - {Unit, S3} = mapfold(F, S2, bitstr_unit(T)), - {Type, S4} = mapfold(F, S3, bitstr_type(T)), - {Flags, S5} = mapfold(F, S4, bitstr_flags(T)), - F(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); - letrec -> - {Ds, S1} = mapfold_pairs(F, S0, letrec_defs(T)), - {B, S2} = mapfold(F, S1, letrec_body(T)), - F(update_c_letrec(T, Ds, B), S2); - module -> - {N, S1} = mapfold(F, S0, module_name(T)), - {Es, S2} = mapfold_list(F, S1, module_exports(T)), - {As, S3} = mapfold_pairs(F, S2, module_attrs(T)), - {Ds, S4} = mapfold_pairs(F, S3, module_defs(T)), - F(update_c_module(T, N, Es, As, Ds), S4) - end. - -mapfold_list(F, S0, [T | Ts]) -> - {T1, S1} = mapfold(F, S0, T), - {Ts1, S2} = mapfold_list(F, S1, Ts), - {[T1 | Ts1], S2}; -mapfold_list(_, S, []) -> - {[], S}. - -mapfold_pairs(F, S0, [{T1, T2} | Ps]) -> - {T3, S1} = mapfold(F, S0, T1), - {T4, S2} = mapfold(F, S1, T2), - {Ps1, S3} = mapfold_pairs(F, S2, Ps), - {[{T3, T4} | Ps1], S3}; -mapfold_pairs(_, S, []) -> - {[], S}. - - -%% --------------------------------------------------------------------- - -%% @spec variables(Tree::cerl()) -> [var_name()] -%% -%% var_name() = integer() | atom() | {atom(), integer()} -%% -%% @doc Returns an ordered-set list of the names of all variables in -%% the syntax tree. (This includes function name variables.) An -%% exception is thrown if <code>Tree</code> does not represent a -%% well-formed Core Erlang syntax tree. -%% -%% @see free_variables/1 - -variables(T) -> - variables(T, false). - - -%% @spec free_variables(Tree::cerl()) -> [var_name()] -%% -%% @doc Like <code>variables/1</code>, but only includes variables -%% that are free in the tree. -%% -%% @see variables/1 - -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); - '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 - 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([{_, F} | Ds], S, A) -> - vars_in_defs(Ds, S, ordsets:union(variables(F, 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. - - -%% --------------------------------------------------------------------- - -%% label(Tree::cerl()) -> {cerl(), integer()} -%% -%% @equiv label(Tree, 0) - -label(T) -> - label(T, 0). - -%% @spec label(Tree::cerl(), N::integer()) -> {cerl(), integer()} -%% -%% @doc Labels each expression in the tree. A term <code>{label, -%% L}</code> 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. -%% -%% <p>The returned value is a tuple <code>{NewTree, Max}</code>, where -%% <code>NewTree</code> is the labeled tree and <code>Max</code> is 1 -%% plus the largest label value used. All previous annotation terms on -%% the form <code>{label, X}</code> are deleted.</p> -%% -%% <p>The values of L used in the tree is a dense range from -%% <code>N</code> to <code>Max - 1</code>, where <code>N =< Max -%% =< N + size(Tree)</code>. Note that it is possible that no -%% labels are used at all, i.e., <code>N = Max</code>.</p> -%% -%% <p>Note: All instances of free variables will be given distinct -%% labels.</p> -%% -%% @see label/1 -%% @see size/1 - -label(T, N) -> - label(T, N, dict:new()). - -label(T, N, Env) -> - case type(T) of - literal -> - %% Constant literals are not labeled. - {T, N}; - var -> - case dict:find(var_name(T), Env) of - {ok, L} -> - {As, _} = label_ann(T, L), - N1 = N; - error -> - {As, N1} = 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}; - '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} - 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 = dict:store(var_name(T), N, Env), - {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([]) -> - []. |