1%% ``Licensed under the Apache License, Version 2.0 (the "License"); 2%% you may not use this file except in compliance with the License. 3%% You may obtain a copy of the License at 4%% 5%% http://www.apache.org/licenses/LICENSE-2.0 6%% 7%% Unless required by applicable law or agreed to in writing, software 8%% distributed under the License is distributed on an "AS IS" BASIS, 9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 10%% See the License for the specific language governing permissions and 11%% limitations under the License. 12%% 13%% The Initial Developer of the Original Code is Richard Carlsson. 14%% Copyright (C) 1999-2002 Richard Carlsson. 15%% Portions created by Ericsson are Copyright 2001, Ericsson Utvecklings 16%% AB. All Rights Reserved.'' 17%% 18%% $Id: cerl_trees.erl,v 1.2 2010/06/07 06:32:39 kostis Exp $ 19 20%% @doc Basic functions on Core Erlang abstract syntax trees. 21%% 22%% <p>Syntax trees are defined in the module <a 23%% href=""><code>cerl</code></a>.</p> 24%% 25%% @type cerl() = cerl:cerl() 26 27-module(cerl_trees). 28 29-export([depth/1, fold/3, free_variables/1, label/1, label/2, map/2, 30 mapfold/3, size/1, variables/1]). 31 32-import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3, 33 ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4, 34 ann_c_case/3, ann_c_catch/2, ann_c_clause/4, 35 ann_c_cons_skel/3, ann_c_fun/3, ann_c_let/4, 36 ann_c_letrec/3, ann_c_module/5, ann_c_primop/3, 37 ann_c_receive/4, ann_c_seq/3, ann_c_try/6, 38 ann_c_tuple_skel/2, ann_c_values/2, apply_args/1, 39 apply_op/1, binary_segments/1, bitstr_val/1, 40 bitstr_size/1, bitstr_unit/1, bitstr_type/1, 41 bitstr_flags/1, call_args/1, call_module/1, call_name/1, 42 case_arg/1, case_clauses/1, catch_body/1, clause_body/1, 43 clause_guard/1, clause_pats/1, clause_vars/1, concrete/1, 44 cons_hd/1, cons_tl/1, fun_body/1, fun_vars/1, get_ann/1, 45 let_arg/1, let_body/1, let_vars/1, letrec_body/1, 46 letrec_defs/1, letrec_vars/1, module_attrs/1, 47 module_defs/1, module_exports/1, module_name/1, 48 module_vars/1, primop_args/1, primop_name/1, 49 receive_action/1, receive_clauses/1, receive_timeout/1, 50 seq_arg/1, seq_body/1, set_ann/2, subtrees/1, try_arg/1, 51 try_body/1, try_vars/1, try_evars/1, try_handler/1, 52 tuple_es/1, type/1, update_c_alias/3, update_c_apply/3, 53 update_c_binary/2, update_c_bitstr/6, update_c_call/4, 54 update_c_case/3, update_c_catch/2, update_c_clause/4, 55 update_c_cons/3, update_c_cons_skel/3, update_c_fun/3, 56 update_c_let/4, update_c_letrec/3, update_c_module/5, 57 update_c_primop/3, update_c_receive/4, update_c_seq/3, 58 update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2, 59 update_c_values/2, values_es/1, var_name/1]). 60 61 62%% --------------------------------------------------------------------- 63 64%% @spec depth(Tree::cerl) -> integer() 65%% 66%% @doc Returns the length of the longest path in the tree. A leaf 67%% node has depth zero, the tree representing "<code>{foo, 68%% bar}</code>" has depth one, etc. 69 70depth(T) -> 71 case subtrees(T) of 72 [] -> 73 0; 74 Gs -> 75 1 + lists:foldl(fun (G, A) -> erlang:max(depth_1(G), A) end, 0, Gs) 76 end. 77 78depth_1(Ts) -> 79 lists:foldl(fun (T, A) -> erlang:max(depth(T), A) end, 0, Ts). 80 81%% max(X, Y) when X > Y -> X; 82%% max(_, Y) -> Y. 83 84 85%% @spec size(Tree::cerl()) -> integer() 86%% 87%% @doc Returns the number of nodes in <code>Tree</code>. 88 89size(T) -> 90 fold(fun (_, S) -> S + 1 end, 0, T). 91 92 93%% --------------------------------------------------------------------- 94 95%% @spec map(Function, Tree::cerl()) -> cerl() 96%% 97%% Function = (cerl()) -> cerl() 98%% 99%% @doc Maps a function onto the nodes of a tree. This replaces each 100%% node in the tree by the result of applying the given function on 101%% the original node, bottom-up. 102%% 103%% @see mapfold/3 104 105map(F, T) -> 106 F(map_1(F, T)). 107 108map_1(F, T) -> 109 case type(T) of 110 literal -> 111 case concrete(T) of 112 [_ | _] -> 113 update_c_cons(T, map(F, cons_hd(T)), 114 map(F, cons_tl(T))); 115 V when tuple_size(V) > 0 -> 116 update_c_tuple(T, map_list(F, tuple_es(T))); 117 _ -> 118 T 119 end; 120 var -> 121 T; 122 values -> 123 update_c_values(T, map_list(F, values_es(T))); 124 cons -> 125 update_c_cons_skel(T, map(F, cons_hd(T)), 126 map(F, cons_tl(T))); 127 tuple -> 128 update_c_tuple_skel(T, map_list(F, tuple_es(T))); 129 'let' -> 130 update_c_let(T, map_list(F, let_vars(T)), 131 map(F, let_arg(T)), 132 map(F, let_body(T))); 133 seq -> 134 update_c_seq(T, map(F, seq_arg(T)), 135 map(F, seq_body(T))); 136 apply -> 137 update_c_apply(T, map(F, apply_op(T)), 138 map_list(F, apply_args(T))); 139 call -> 140 update_c_call(T, map(F, call_module(T)), 141 map(F, call_name(T)), 142 map_list(F, call_args(T))); 143 primop -> 144 update_c_primop(T, map(F, primop_name(T)), 145 map_list(F, primop_args(T))); 146 'case' -> 147 update_c_case(T, map(F, case_arg(T)), 148 map_list(F, case_clauses(T))); 149 clause -> 150 update_c_clause(T, map_list(F, clause_pats(T)), 151 map(F, clause_guard(T)), 152 map(F, clause_body(T))); 153 alias -> 154 update_c_alias(T, map(F, alias_var(T)), 155 map(F, alias_pat(T))); 156 'fun' -> 157 update_c_fun(T, map_list(F, fun_vars(T)), 158 map(F, fun_body(T))); 159 'receive' -> 160 update_c_receive(T, map_list(F, receive_clauses(T)), 161 map(F, receive_timeout(T)), 162 map(F, receive_action(T))); 163 'try' -> 164 update_c_try(T, map(F, try_arg(T)), 165 map_list(F, try_vars(T)), 166 map(F, try_body(T)), 167 map_list(F, try_evars(T)), 168 map(F, try_handler(T))); 169 'catch' -> 170 update_c_catch(T, map(F, catch_body(T))); 171 binary -> 172 update_c_binary(T, map_list(F, binary_segments(T))); 173 bitstr -> 174 update_c_bitstr(T, map(F, bitstr_val(T)), 175 map(F, bitstr_size(T)), 176 map(F, bitstr_unit(T)), 177 map(F, bitstr_type(T)), 178 map(F, bitstr_flags(T))); 179 letrec -> 180 update_c_letrec(T, map_pairs(F, letrec_defs(T)), 181 map(F, letrec_body(T))); 182 module -> 183 update_c_module(T, map(F, module_name(T)), 184 map_list(F, module_exports(T)), 185 map_pairs(F, module_attrs(T)), 186 map_pairs(F, module_defs(T))) 187 end. 188 189map_list(F, [T | Ts]) -> 190 [map(F, T) | map_list(F, Ts)]; 191map_list(_, []) -> 192 []. 193 194map_pairs(F, [{T1, T2} | Ps]) -> 195 [{map(F, T1), map(F, T2)} | map_pairs(F, Ps)]; 196map_pairs(_, []) -> 197 []. 198 199 200%% @spec fold(Function, Unit::term(), Tree::cerl()) -> term() 201%% 202%% Function = (cerl(), term()) -> term() 203%% 204%% @doc Does a fold operation over the nodes of the tree. The result 205%% is the value of <code>Function(X1, Function(X2, ... Function(Xn, 206%% Unit) ... ))</code>, where <code>X1, ..., Xn</code> are the nodes 207%% of <code>Tree</code> in a post-order traversal. 208%% 209%% @see mapfold/3 210 211fold(F, S, T) -> 212 F(T, fold_1(F, S, T)). 213 214fold_1(F, S, T) -> 215 case type(T) of 216 literal -> 217 case concrete(T) of 218 [_ | _] -> 219 fold(F, fold(F, S, cons_hd(T)), cons_tl(T)); 220 V when tuple_size(V) > 0 -> 221 fold_list(F, S, tuple_es(T)); 222 _ -> 223 S 224 end; 225 var -> 226 S; 227 values -> 228 fold_list(F, S, values_es(T)); 229 cons -> 230 fold(F, fold(F, S, cons_hd(T)), cons_tl(T)); 231 tuple -> 232 fold_list(F, S, tuple_es(T)); 233 'let' -> 234 fold(F, fold(F, fold_list(F, S, let_vars(T)), 235 let_arg(T)), 236 let_body(T)); 237 seq -> 238 fold(F, fold(F, S, seq_arg(T)), seq_body(T)); 239 apply -> 240 fold_list(F, fold(F, S, apply_op(T)), apply_args(T)); 241 call -> 242 fold_list(F, fold(F, fold(F, S, call_module(T)), 243 call_name(T)), 244 call_args(T)); 245 primop -> 246 fold_list(F, fold(F, S, primop_name(T)), primop_args(T)); 247 'case' -> 248 fold_list(F, fold(F, S, case_arg(T)), case_clauses(T)); 249 clause -> 250 fold(F, fold(F, fold_list(F, S, clause_pats(T)), 251 clause_guard(T)), 252 clause_body(T)); 253 alias -> 254 fold(F, fold(F, S, alias_var(T)), alias_pat(T)); 255 'fun' -> 256 fold(F, fold_list(F, S, fun_vars(T)), fun_body(T)); 257 'receive' -> 258 fold(F, fold(F, fold_list(F, S, receive_clauses(T)), 259 receive_timeout(T)), 260 receive_action(T)); 261 'try' -> 262 fold(F, fold_list(F, fold(F, fold_list(F, fold(F, S, try_arg(T)), 263 try_vars(T)), 264 try_body(T)), 265 try_evars(T)), 266 try_handler(T)); 267 'catch' -> 268 fold(F, S, catch_body(T)); 269 binary -> 270 fold_list(F, S, binary_segments(T)); 271 bitstr -> 272 fold(F, 273 fold(F, 274 fold(F, 275 fold(F, 276 fold(F, S, bitstr_val(T)), 277 bitstr_size(T)), 278 bitstr_unit(T)), 279 bitstr_type(T)), 280 bitstr_flags(T)); 281 letrec -> 282 fold(F, fold_pairs(F, S, letrec_defs(T)), letrec_body(T)); 283 module -> 284 fold_pairs(F, 285 fold_pairs(F, 286 fold_list(F, 287 fold(F, S, module_name(T)), 288 module_exports(T)), 289 module_attrs(T)), 290 module_defs(T)) 291 end. 292 293fold_list(F, S, [T | Ts]) -> 294 fold_list(F, fold(F, S, T), Ts); 295fold_list(_, S, []) -> 296 S. 297 298fold_pairs(F, S, [{T1, T2} | Ps]) -> 299 fold_pairs(F, fold(F, fold(F, S, T1), T2), Ps); 300fold_pairs(_, S, []) -> 301 S. 302 303 304%% @spec mapfold(Function, Initial::term(), Tree::cerl()) -> 305%% {cerl(), term()} 306%% 307%% Function = (cerl(), term()) -> {cerl(), term()} 308%% 309%% @doc Does a combined map/fold operation on the nodes of the 310%% tree. This is similar to <code>map/2</code>, but also propagates a 311%% value from each application of <code>Function</code> to the next, 312%% starting with the given value <code>Initial</code>, while doing a 313%% post-order traversal of the tree, much like <code>fold/3</code>. 314%% 315%% @see map/2 316%% @see fold/3 317 318mapfold(F, S0, T) -> 319 case type(T) of 320 literal -> 321 case concrete(T) of 322 [_ | _] -> 323 {T1, S1} = mapfold(F, S0, cons_hd(T)), 324 {T2, S2} = mapfold(F, S1, cons_tl(T)), 325 F(update_c_cons(T, T1, T2), S2); 326 V when tuple_size(V) > 0 -> 327 {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), 328 F(update_c_tuple(T, Ts), S1); 329 _ -> 330 F(T, S0) 331 end; 332 var -> 333 F(T, S0); 334 values -> 335 {Ts, S1} = mapfold_list(F, S0, values_es(T)), 336 F(update_c_values(T, Ts), S1); 337 cons -> 338 {T1, S1} = mapfold(F, S0, cons_hd(T)), 339 {T2, S2} = mapfold(F, S1, cons_tl(T)), 340 F(update_c_cons_skel(T, T1, T2), S2); 341 tuple -> 342 {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), 343 F(update_c_tuple_skel(T, Ts), S1); 344 'let' -> 345 {Vs, S1} = mapfold_list(F, S0, let_vars(T)), 346 {A, S2} = mapfold(F, S1, let_arg(T)), 347 {B, S3} = mapfold(F, S2, let_body(T)), 348 F(update_c_let(T, Vs, A, B), S3); 349 seq -> 350 {A, S1} = mapfold(F, S0, seq_arg(T)), 351 {B, S2} = mapfold(F, S1, seq_body(T)), 352 F(update_c_seq(T, A, B), S2); 353 apply -> 354 {E, S1} = mapfold(F, S0, apply_op(T)), 355 {As, S2} = mapfold_list(F, S1, apply_args(T)), 356 F(update_c_apply(T, E, As), S2); 357 call -> 358 {M, S1} = mapfold(F, S0, call_module(T)), 359 {N, S2} = mapfold(F, S1, call_name(T)), 360 {As, S3} = mapfold_list(F, S2, call_args(T)), 361 F(update_c_call(T, M, N, As), S3); 362 primop -> 363 {N, S1} = mapfold(F, S0, primop_name(T)), 364 {As, S2} = mapfold_list(F, S1, primop_args(T)), 365 F(update_c_primop(T, N, As), S2); 366 'case' -> 367 {A, S1} = mapfold(F, S0, case_arg(T)), 368 {Cs, S2} = mapfold_list(F, S1, case_clauses(T)), 369 F(update_c_case(T, A, Cs), S2); 370 clause -> 371 {Ps, S1} = mapfold_list(F, S0, clause_pats(T)), 372 {G, S2} = mapfold(F, S1, clause_guard(T)), 373 {B, S3} = mapfold(F, S2, clause_body(T)), 374 F(update_c_clause(T, Ps, G, B), S3); 375 alias -> 376 {V, S1} = mapfold(F, S0, alias_var(T)), 377 {P, S2} = mapfold(F, S1, alias_pat(T)), 378 F(update_c_alias(T, V, P), S2); 379 'fun' -> 380 {Vs, S1} = mapfold_list(F, S0, fun_vars(T)), 381 {B, S2} = mapfold(F, S1, fun_body(T)), 382 F(update_c_fun(T, Vs, B), S2); 383 'receive' -> 384 {Cs, S1} = mapfold_list(F, S0, receive_clauses(T)), 385 {E, S2} = mapfold(F, S1, receive_timeout(T)), 386 {A, S3} = mapfold(F, S2, receive_action(T)), 387 F(update_c_receive(T, Cs, E, A), S3); 388 'try' -> 389 {E, S1} = mapfold(F, S0, try_arg(T)), 390 {Vs, S2} = mapfold_list(F, S1, try_vars(T)), 391 {B, S3} = mapfold(F, S2, try_body(T)), 392 {Evs, S4} = mapfold_list(F, S3, try_evars(T)), 393 {H, S5} = mapfold(F, S4, try_handler(T)), 394 F(update_c_try(T, E, Vs, B, Evs, H), S5); 395 'catch' -> 396 {B, S1} = mapfold(F, S0, catch_body(T)), 397 F(update_c_catch(T, B), S1); 398 binary -> 399 {Ds, S1} = mapfold_list(F, S0, binary_segments(T)), 400 F(update_c_binary(T, Ds), S1); 401 bitstr -> 402 {Val, S1} = mapfold(F, S0, bitstr_val(T)), 403 {Size, S2} = mapfold(F, S1, bitstr_size(T)), 404 {Unit, S3} = mapfold(F, S2, bitstr_unit(T)), 405 {Type, S4} = mapfold(F, S3, bitstr_type(T)), 406 {Flags, S5} = mapfold(F, S4, bitstr_flags(T)), 407 F(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); 408 letrec -> 409 {Ds, S1} = mapfold_pairs(F, S0, letrec_defs(T)), 410 {B, S2} = mapfold(F, S1, letrec_body(T)), 411 F(update_c_letrec(T, Ds, B), S2); 412 module -> 413 {N, S1} = mapfold(F, S0, module_name(T)), 414 {Es, S2} = mapfold_list(F, S1, module_exports(T)), 415 {As, S3} = mapfold_pairs(F, S2, module_attrs(T)), 416 {Ds, S4} = mapfold_pairs(F, S3, module_defs(T)), 417 F(update_c_module(T, N, Es, As, Ds), S4) 418 end. 419 420mapfold_list(F, S0, [T | Ts]) -> 421 {T1, S1} = mapfold(F, S0, T), 422 {Ts1, S2} = mapfold_list(F, S1, Ts), 423 {[T1 | Ts1], S2}; 424mapfold_list(_, S, []) -> 425 {[], S}. 426 427mapfold_pairs(F, S0, [{T1, T2} | Ps]) -> 428 {T3, S1} = mapfold(F, S0, T1), 429 {T4, S2} = mapfold(F, S1, T2), 430 {Ps1, S3} = mapfold_pairs(F, S2, Ps), 431 {[{T3, T4} | Ps1], S3}; 432mapfold_pairs(_, S, []) -> 433 {[], S}. 434 435 436%% --------------------------------------------------------------------- 437 438%% @spec variables(Tree::cerl()) -> [var_name()] 439%% 440%% var_name() = integer() | atom() | {atom(), integer()} 441%% 442%% @doc Returns an ordered-set list of the names of all variables in 443%% the syntax tree. (This includes function name variables.) An 444%% exception is thrown if <code>Tree</code> does not represent a 445%% well-formed Core Erlang syntax tree. 446%% 447%% @see free_variables/1 448 449variables(T) -> 450 variables(T, false). 451 452 453%% @spec free_variables(Tree::cerl()) -> [var_name()] 454%% 455%% @doc Like <code>variables/1</code>, but only includes variables 456%% that are free in the tree. 457%% 458%% @see variables/1 459 460free_variables(T) -> 461 variables(T, true). 462 463 464%% This is not exported 465 466variables(T, S) -> 467 case type(T) of 468 literal -> 469 []; 470 var -> 471 [var_name(T)]; 472 values -> 473 vars_in_list(values_es(T), S); 474 cons -> 475 ordsets:union(variables(cons_hd(T), S), 476 variables(cons_tl(T), S)); 477 tuple -> 478 vars_in_list(tuple_es(T), S); 479 'let' -> 480 Vs = variables(let_body(T), S), 481 Vs1 = var_list_names(let_vars(T)), 482 Vs2 = case S of 483 true -> 484 ordsets:subtract(Vs, Vs1); 485 false -> 486 ordsets:union(Vs, Vs1) 487 end, 488 ordsets:union(variables(let_arg(T), S), Vs2); 489 seq -> 490 ordsets:union(variables(seq_arg(T), S), 491 variables(seq_body(T), S)); 492 apply -> 493 ordsets:union( 494 variables(apply_op(T), S), 495 vars_in_list(apply_args(T), S)); 496 call -> 497 ordsets:union(variables(call_module(T), S), 498 ordsets:union( 499 variables(call_name(T), S), 500 vars_in_list(call_args(T), S))); 501 primop -> 502 vars_in_list(primop_args(T), S); 503 'case' -> 504 ordsets:union(variables(case_arg(T), S), 505 vars_in_list(case_clauses(T), S)); 506 clause -> 507 Vs = ordsets:union(variables(clause_guard(T), S), 508 variables(clause_body(T), S)), 509 Vs1 = vars_in_list(clause_pats(T), S), 510 case S of 511 true -> 512 ordsets:subtract(Vs, Vs1); 513 false -> 514 ordsets:union(Vs, Vs1) 515 end; 516 alias -> 517 ordsets:add_element(var_name(alias_var(T)), 518 variables(alias_pat(T))); 519 'fun' -> 520 Vs = variables(fun_body(T), S), 521 Vs1 = var_list_names(fun_vars(T)), 522 case S of 523 true -> 524 ordsets:subtract(Vs, Vs1); 525 false -> 526 ordsets:union(Vs, Vs1) 527 end; 528 'receive' -> 529 ordsets:union( 530 vars_in_list(receive_clauses(T), S), 531 ordsets:union(variables(receive_timeout(T), S), 532 variables(receive_action(T), S))); 533 'try' -> 534 Vs = variables(try_body(T), S), 535 Vs1 = var_list_names(try_vars(T)), 536 Vs2 = case S of 537 true -> 538 ordsets:subtract(Vs, Vs1); 539 false -> 540 ordsets:union(Vs, Vs1) 541 end, 542 Vs3 = variables(try_handler(T), S), 543 Vs4 = var_list_names(try_evars(T)), 544 Vs5 = case S of 545 true -> 546 ordsets:subtract(Vs3, Vs4); 547 false -> 548 ordsets:union(Vs3, Vs4) 549 end, 550 ordsets:union(variables(try_arg(T), S), 551 ordsets:union(Vs2, Vs5)); 552 'catch' -> 553 variables(catch_body(T), S); 554 binary -> 555 vars_in_list(binary_segments(T), S); 556 bitstr -> 557 ordsets:union(variables(bitstr_val(T), S), 558 variables(bitstr_size(T), S)); 559 letrec -> 560 Vs = vars_in_defs(letrec_defs(T), S), 561 Vs1 = ordsets:union(variables(letrec_body(T), S), Vs), 562 Vs2 = var_list_names(letrec_vars(T)), 563 case S of 564 true -> 565 ordsets:subtract(Vs1, Vs2); 566 false -> 567 ordsets:union(Vs1, Vs2) 568 end; 569 module -> 570 Vs = vars_in_defs(module_defs(T), S), 571 Vs1 = ordsets:union(vars_in_list(module_exports(T), S), Vs), 572 Vs2 = var_list_names(module_vars(T)), 573 case S of 574 true -> 575 ordsets:subtract(Vs1, Vs2); 576 false -> 577 ordsets:union(Vs1, Vs2) 578 end 579 end. 580 581vars_in_list(Ts, S) -> 582 vars_in_list(Ts, S, []). 583 584vars_in_list([T | Ts], S, A) -> 585 vars_in_list(Ts, S, ordsets:union(variables(T, S), A)); 586vars_in_list([], _, A) -> 587 A. 588 589%% Note that this function only visits the right-hand side of function 590%% definitions. 591 592vars_in_defs(Ds, S) -> 593 vars_in_defs(Ds, S, []). 594 595vars_in_defs([{_, F} | Ds], S, A) -> 596 vars_in_defs(Ds, S, ordsets:union(variables(F, S), A)); 597vars_in_defs([], _, A) -> 598 A. 599 600%% This amounts to insertion sort. Since the lists are generally short, 601%% it is hardly worthwhile to use an asymptotically better sort. 602 603var_list_names(Vs) -> 604 var_list_names(Vs, []). 605 606var_list_names([V | Vs], A) -> 607 var_list_names(Vs, ordsets:add_element(var_name(V), A)); 608var_list_names([], A) -> 609 A. 610 611 612%% --------------------------------------------------------------------- 613 614%% label(Tree::cerl()) -> {cerl(), integer()} 615%% 616%% @equiv label(Tree, 0) 617 618label(T) -> 619 label(T, 0). 620 621%% @spec label(Tree::cerl(), N::integer()) -> {cerl(), integer()} 622%% 623%% @doc Labels each expression in the tree. A term <code>{label, 624%% L}</code> is prefixed to the annotation list of each expression node, 625%% where L is a unique number for every node, except for variables (and 626%% function name variables) which get the same label if they represent 627%% the same variable. Constant literal nodes are not labeled. 628%% 629%% <p>The returned value is a tuple <code>{NewTree, Max}</code>, where 630%% <code>NewTree</code> is the labeled tree and <code>Max</code> is 1 631%% plus the largest label value used. All previous annotation terms on 632%% the form <code>{label, X}</code> are deleted.</p> 633%% 634%% <p>The values of L used in the tree is a dense range from 635%% <code>N</code> to <code>Max - 1</code>, where <code>N =< Max 636%% =< N + size(Tree)</code>. Note that it is possible that no 637%% labels are used at all, i.e., <code>N = Max</code>.</p> 638%% 639%% <p>Note: All instances of free variables will be given distinct 640%% labels.</p> 641%% 642%% @see label/1 643%% @see size/1 644 645label(T, N) -> 646 label(T, N, dict:new()). 647 648label(T, N, Env) -> 649 case type(T) of 650 literal -> 651 %% Constant literals are not labeled. 652 {T, N}; 653 var -> 654 case dict:find(var_name(T), Env) of 655 {ok, L} -> 656 {As, _} = label_ann(T, L), 657 N1 = N; 658 error -> 659 {As, N1} = label_ann(T, N) 660 end, 661 {set_ann(T, As), N1}; 662 values -> 663 {Ts, N1} = label_list(values_es(T), N, Env), 664 {As, N2} = label_ann(T, N1), 665 {ann_c_values(As, Ts), N2}; 666 cons -> 667 {T1, N1} = label(cons_hd(T), N, Env), 668 {T2, N2} = label(cons_tl(T), N1, Env), 669 {As, N3} = label_ann(T, N2), 670 {ann_c_cons_skel(As, T1, T2), N3}; 671 tuple -> 672 {Ts, N1} = label_list(tuple_es(T), N, Env), 673 {As, N2} = label_ann(T, N1), 674 {ann_c_tuple_skel(As, Ts), N2}; 675 'let' -> 676 {A, N1} = label(let_arg(T), N, Env), 677 {Vs, N2, Env1} = label_vars(let_vars(T), N1, Env), 678 {B, N3} = label(let_body(T), N2, Env1), 679 {As, N4} = label_ann(T, N3), 680 {ann_c_let(As, Vs, A, B), N4}; 681 seq -> 682 {A, N1} = label(seq_arg(T), N, Env), 683 {B, N2} = label(seq_body(T), N1, Env), 684 {As, N3} = label_ann(T, N2), 685 {ann_c_seq(As, A, B), N3}; 686 apply -> 687 {E, N1} = label(apply_op(T), N, Env), 688 {Es, N2} = label_list(apply_args(T), N1, Env), 689 {As, N3} = label_ann(T, N2), 690 {ann_c_apply(As, E, Es), N3}; 691 call -> 692 {M, N1} = label(call_module(T), N, Env), 693 {F, N2} = label(call_name(T), N1, Env), 694 {Es, N3} = label_list(call_args(T), N2, Env), 695 {As, N4} = label_ann(T, N3), 696 {ann_c_call(As, M, F, Es), N4}; 697 primop -> 698 {F, N1} = label(primop_name(T), N, Env), 699 {Es, N2} = label_list(primop_args(T), N1, Env), 700 {As, N3} = label_ann(T, N2), 701 {ann_c_primop(As, F, Es), N3}; 702 'case' -> 703 {A, N1} = label(case_arg(T), N, Env), 704 {Cs, N2} = label_list(case_clauses(T), N1, Env), 705 {As, N3} = label_ann(T, N2), 706 {ann_c_case(As, A, Cs), N3}; 707 clause -> 708 {_, N1, Env1} = label_vars(clause_vars(T), N, Env), 709 {Ps, N2} = label_list(clause_pats(T), N1, Env1), 710 {G, N3} = label(clause_guard(T), N2, Env1), 711 {B, N4} = label(clause_body(T), N3, Env1), 712 {As, N5} = label_ann(T, N4), 713 {ann_c_clause(As, Ps, G, B), N5}; 714 alias -> 715 {V, N1} = label(alias_var(T), N, Env), 716 {P, N2} = label(alias_pat(T), N1, Env), 717 {As, N3} = label_ann(T, N2), 718 {ann_c_alias(As, V, P), N3}; 719 'fun' -> 720 {Vs, N1, Env1} = label_vars(fun_vars(T), N, Env), 721 {B, N2} = label(fun_body(T), N1, Env1), 722 {As, N3} = label_ann(T, N2), 723 {ann_c_fun(As, Vs, B), N3}; 724 'receive' -> 725 {Cs, N1} = label_list(receive_clauses(T), N, Env), 726 {E, N2} = label(receive_timeout(T), N1, Env), 727 {A, N3} = label(receive_action(T), N2, Env), 728 {As, N4} = label_ann(T, N3), 729 {ann_c_receive(As, Cs, E, A), N4}; 730 'try' -> 731 {E, N1} = label(try_arg(T), N, Env), 732 {Vs, N2, Env1} = label_vars(try_vars(T), N1, Env), 733 {B, N3} = label(try_body(T), N2, Env1), 734 {Evs, N4, Env2} = label_vars(try_evars(T), N3, Env), 735 {H, N5} = label(try_handler(T), N4, Env2), 736 {As, N6} = label_ann(T, N5), 737 {ann_c_try(As, E, Vs, B, Evs, H), N6}; 738 'catch' -> 739 {B, N1} = label(catch_body(T), N, Env), 740 {As, N2} = label_ann(T, N1), 741 {ann_c_catch(As, B), N2}; 742 binary -> 743 {Ds, N1} = label_list(binary_segments(T), N, Env), 744 {As, N2} = label_ann(T, N1), 745 {ann_c_binary(As, Ds), N2}; 746 bitstr -> 747 {Val, N1} = label(bitstr_val(T), N, Env), 748 {Size, N2} = label(bitstr_size(T), N1, Env), 749 {Unit, N3} = label(bitstr_unit(T), N2, Env), 750 {Type, N4} = label(bitstr_type(T), N3, Env), 751 {Flags, N5} = label(bitstr_flags(T), N4, Env), 752 {As, N6} = label_ann(T, N5), 753 {ann_c_bitstr(As, Val, Size, Unit, Type, Flags), N6}; 754 letrec -> 755 {_, N1, Env1} = label_vars(letrec_vars(T), N, Env), 756 {Ds, N2} = label_defs(letrec_defs(T), N1, Env1), 757 {B, N3} = label(letrec_body(T), N2, Env1), 758 {As, N4} = label_ann(T, N3), 759 {ann_c_letrec(As, Ds, B), N4}; 760 module -> 761 %% The module name is not labeled. 762 {_, N1, Env1} = label_vars(module_vars(T), N, Env), 763 {Ts, N2} = label_defs(module_attrs(T), N1, Env1), 764 {Ds, N3} = label_defs(module_defs(T), N2, Env1), 765 {Es, N4} = label_list(module_exports(T), N3, Env1), 766 {As, N5} = label_ann(T, N4), 767 {ann_c_module(As, module_name(T), Es, Ts, Ds), N5} 768 end. 769 770label_list([T | Ts], N, Env) -> 771 {T1, N1} = label(T, N, Env), 772 {Ts1, N2} = label_list(Ts, N1, Env), 773 {[T1 | Ts1], N2}; 774label_list([], N, _Env) -> 775 {[], N}. 776 777label_vars([T | Ts], N, Env) -> 778 Env1 = dict:store(var_name(T), N, Env), 779 {As, N1} = label_ann(T, N), 780 T1 = set_ann(T, As), 781 {Ts1, N2, Env2} = label_vars(Ts, N1, Env1), 782 {[T1 | Ts1], N2, Env2}; 783label_vars([], N, Env) -> 784 {[], N, Env}. 785 786label_defs([{F, T} | Ds], N, Env) -> 787 {F1, N1} = label(F, N, Env), 788 {T1, N2} = label(T, N1, Env), 789 {Ds1, N3} = label_defs(Ds, N2, Env), 790 {[{F1, T1} | Ds1], N3}; 791label_defs([], N, _Env) -> 792 {[], N}. 793 794label_ann(T, N) -> 795 {[{label, N} | filter_labels(get_ann(T))], N + 1}. 796 797filter_labels([{label, _} | As]) -> 798 filter_labels(As); 799filter_labels([A | As]) -> 800 [A | filter_labels(As)]; 801filter_labels([]) -> 802 []. 803