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%% @copyright 1999-2002 Richard Carlsson. 14%% @author Richard Carlsson <carlsson.richard@gmail.com> 15%% @doc Basic functions on Core Erlang abstract syntax trees. 16%% 17%% <p>Syntax trees are defined in the module <a 18%% href="cerl"><code>cerl</code></a>.</p> 19%% 20%% @type cerl() = cerl:cerl() 21 22-module(cerl_trees). 23 24-export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2, 25 map/2, mapfold/3, mapfold/4, next_free_variable_name/1, 26 size/1, variables/1]). 27 28-import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3, 29 ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4, 30 ann_c_case/3, ann_c_catch/2, ann_c_clause/4, 31 ann_c_cons_skel/3, ann_c_fun/3, ann_c_let/4, 32 ann_c_letrec/3, ann_c_module/5, ann_c_primop/3, 33 ann_c_receive/4, ann_c_seq/3, ann_c_try/6, 34 ann_c_tuple_skel/2, ann_c_values/2, apply_args/1, 35 apply_op/1, binary_segments/1, bitstr_val/1, 36 bitstr_size/1, bitstr_unit/1, bitstr_type/1, 37 bitstr_flags/1, call_args/1, call_module/1, call_name/1, 38 case_arg/1, case_clauses/1, catch_body/1, clause_body/1, 39 clause_guard/1, clause_pats/1, clause_vars/1, concrete/1, 40 cons_hd/1, cons_tl/1, fun_body/1, fun_vars/1, get_ann/1, 41 let_arg/1, let_body/1, let_vars/1, letrec_body/1, 42 letrec_defs/1, letrec_vars/1, module_attrs/1, 43 module_defs/1, module_exports/1, module_name/1, 44 module_vars/1, primop_args/1, primop_name/1, 45 receive_action/1, receive_clauses/1, receive_timeout/1, 46 seq_arg/1, seq_body/1, set_ann/2, subtrees/1, try_arg/1, 47 try_body/1, try_vars/1, try_evars/1, try_handler/1, 48 tuple_es/1, type/1, update_c_alias/3, update_c_apply/3, 49 update_c_binary/2, update_c_bitstr/6, update_c_call/4, 50 update_c_case/3, update_c_catch/2, update_c_clause/4, 51 update_c_cons/3, update_c_cons_skel/3, update_c_fun/3, 52 update_c_let/4, update_c_letrec/3, update_c_module/5, 53 update_c_primop/3, update_c_receive/4, update_c_seq/3, 54 update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2, 55 update_c_values/2, values_es/1, var_name/1, 56 57 map_arg/1, map_es/1, 58 ann_c_map/3, 59 update_c_map/3, 60 is_c_map_pattern/1, ann_c_map_pattern/2, 61 map_pair_key/1,map_pair_val/1,map_pair_op/1, 62 ann_c_map_pair/4, 63 update_c_map_pair/4 64 ]). 65 66 67%% --------------------------------------------------------------------- 68 69%% @spec depth(Tree::cerl()) -> integer() 70%% 71%% @doc Returns the length of the longest path in the tree. A leaf 72%% node has depth zero, the tree representing "<code>{foo, 73%% bar}</code>" has depth one, etc. 74 75-spec depth(cerl:cerl()) -> non_neg_integer(). 76 77depth(T) -> 78 case subtrees(T) of 79 [] -> 80 0; 81 Gs -> 82 1 + lists:foldl(fun (G, A) -> erlang:max(depth_1(G), A) end, 0, Gs) 83 end. 84 85depth_1(Ts) -> 86 lists:foldl(fun (T, A) -> erlang:max(depth(T), A) end, 0, Ts). 87 88 89 90%% @spec size(Tree::cerl()) -> integer() 91%% 92%% @doc Returns the number of nodes in <code>Tree</code>. 93 94-spec size(cerl:cerl()) -> non_neg_integer(). 95 96size(T) -> 97 fold(fun (_, S) -> S + 1 end, 0, T). 98 99 100%% --------------------------------------------------------------------- 101 102%% @spec map(Function, Tree::cerl()) -> cerl() 103%% 104%% Function = (cerl()) -> cerl() 105%% 106%% @doc Maps a function onto the nodes of a tree. This replaces each 107%% node in the tree by the result of applying the given function on 108%% the original node, bottom-up. 109%% 110%% @see mapfold/3 111 112-spec map(fun((cerl:cerl()) -> cerl:cerl()), cerl:cerl()) -> cerl:cerl(). 113 114map(F, T) -> 115 F(map_1(F, T)). 116 117map_1(F, T) -> 118 case type(T) of 119 literal -> 120 case concrete(T) of 121 [_ | _] -> 122 update_c_cons(T, map(F, cons_hd(T)), 123 map(F, cons_tl(T))); 124 V when tuple_size(V) > 0 -> 125 update_c_tuple(T, map_list(F, tuple_es(T))); 126 _ -> 127 T 128 end; 129 var -> 130 T; 131 values -> 132 update_c_values(T, map_list(F, values_es(T))); 133 cons -> 134 update_c_cons_skel(T, map(F, cons_hd(T)), 135 map(F, cons_tl(T))); 136 tuple -> 137 update_c_tuple_skel(T, map_list(F, tuple_es(T))); 138 map -> 139 update_c_map(T, map(F, map_arg(T)), map_list(F, map_es(T))); 140 map_pair -> 141 update_c_map_pair(T, map(F, map_pair_op(T)), 142 map(F, map_pair_key(T)), 143 map(F, map_pair_val(T))); 144 'let' -> 145 update_c_let(T, map_list(F, let_vars(T)), 146 map(F, let_arg(T)), 147 map(F, let_body(T))); 148 seq -> 149 update_c_seq(T, map(F, seq_arg(T)), 150 map(F, seq_body(T))); 151 apply -> 152 update_c_apply(T, map(F, apply_op(T)), 153 map_list(F, apply_args(T))); 154 call -> 155 update_c_call(T, map(F, call_module(T)), 156 map(F, call_name(T)), 157 map_list(F, call_args(T))); 158 primop -> 159 update_c_primop(T, map(F, primop_name(T)), 160 map_list(F, primop_args(T))); 161 'case' -> 162 update_c_case(T, map(F, case_arg(T)), 163 map_list(F, case_clauses(T))); 164 clause -> 165 update_c_clause(T, map_list(F, clause_pats(T)), 166 map(F, clause_guard(T)), 167 map(F, clause_body(T))); 168 alias -> 169 update_c_alias(T, map(F, alias_var(T)), 170 map(F, alias_pat(T))); 171 'fun' -> 172 update_c_fun(T, map_list(F, fun_vars(T)), 173 map(F, fun_body(T))); 174 'receive' -> 175 update_c_receive(T, map_list(F, receive_clauses(T)), 176 map(F, receive_timeout(T)), 177 map(F, receive_action(T))); 178 'try' -> 179 update_c_try(T, map(F, try_arg(T)), 180 map_list(F, try_vars(T)), 181 map(F, try_body(T)), 182 map_list(F, try_evars(T)), 183 map(F, try_handler(T))); 184 'catch' -> 185 update_c_catch(T, map(F, catch_body(T))); 186 binary -> 187 update_c_binary(T, map_list(F, binary_segments(T))); 188 bitstr -> 189 update_c_bitstr(T, map(F, bitstr_val(T)), 190 map(F, bitstr_size(T)), 191 map(F, bitstr_unit(T)), 192 map(F, bitstr_type(T)), 193 map(F, bitstr_flags(T))); 194 letrec -> 195 update_c_letrec(T, map_pairs(F, letrec_defs(T)), 196 map(F, letrec_body(T))); 197 module -> 198 update_c_module(T, map(F, module_name(T)), 199 map_list(F, module_exports(T)), 200 map_pairs(F, module_attrs(T)), 201 map_pairs(F, module_defs(T))) 202 end. 203 204map_list(F, [T | Ts]) -> 205 [map(F, T) | map_list(F, Ts)]; 206map_list(_, []) -> 207 []. 208 209map_pairs(F, [{T1, T2} | Ps]) -> 210 [{map(F, T1), map(F, T2)} | map_pairs(F, Ps)]; 211map_pairs(_, []) -> 212 []. 213 214 215%% @spec fold(Function, Unit::term(), Tree::cerl()) -> term() 216%% 217%% Function = (cerl(), term()) -> term() 218%% 219%% @doc Does a fold operation over the nodes of the tree. The result 220%% is the value of <code>Function(X1, Function(X2, ... Function(Xn, 221%% Unit) ... ))</code>, where <code>X1, ..., Xn</code> are the nodes 222%% of <code>Tree</code> in a post-order traversal. 223%% 224%% @see mapfold/3 225 226-spec fold(fun((cerl:cerl(), term()) -> term()), term(), cerl:cerl()) -> term(). 227 228fold(F, S, T) -> 229 F(T, fold_1(F, S, T)). 230 231fold_1(F, S, T) -> 232 case type(T) of 233 literal -> 234 case concrete(T) of 235 [_ | _] -> 236 fold(F, fold(F, S, cons_hd(T)), cons_tl(T)); 237 V when tuple_size(V) > 0 -> 238 fold_list(F, S, tuple_es(T)); 239 _ -> 240 S 241 end; 242 var -> 243 S; 244 values -> 245 fold_list(F, S, values_es(T)); 246 cons -> 247 fold(F, fold(F, S, cons_hd(T)), cons_tl(T)); 248 tuple -> 249 fold_list(F, S, tuple_es(T)); 250 map -> 251 fold_list(F, S, map_es(T)); 252 map_pair -> 253 fold(F, 254 fold(F, 255 fold(F, S, map_pair_op(T)), 256 map_pair_key(T)), 257 map_pair_val(T)); 258 'let' -> 259 fold(F, fold(F, fold_list(F, S, let_vars(T)), 260 let_arg(T)), 261 let_body(T)); 262 seq -> 263 fold(F, fold(F, S, seq_arg(T)), seq_body(T)); 264 apply -> 265 fold_list(F, fold(F, S, apply_op(T)), apply_args(T)); 266 call -> 267 fold_list(F, fold(F, fold(F, S, call_module(T)), 268 call_name(T)), 269 call_args(T)); 270 primop -> 271 fold_list(F, fold(F, S, primop_name(T)), primop_args(T)); 272 'case' -> 273 fold_list(F, fold(F, S, case_arg(T)), case_clauses(T)); 274 clause -> 275 fold(F, fold(F, fold_list(F, S, clause_pats(T)), 276 clause_guard(T)), 277 clause_body(T)); 278 alias -> 279 fold(F, fold(F, S, alias_var(T)), alias_pat(T)); 280 'fun' -> 281 fold(F, fold_list(F, S, fun_vars(T)), fun_body(T)); 282 'receive' -> 283 fold(F, fold(F, fold_list(F, S, receive_clauses(T)), 284 receive_timeout(T)), 285 receive_action(T)); 286 'try' -> 287 fold(F, fold_list(F, fold(F, fold_list(F, fold(F, S, try_arg(T)), 288 try_vars(T)), 289 try_body(T)), 290 try_evars(T)), 291 try_handler(T)); 292 'catch' -> 293 fold(F, S, catch_body(T)); 294 binary -> 295 fold_list(F, S, binary_segments(T)); 296 bitstr -> 297 fold(F, 298 fold(F, 299 fold(F, 300 fold(F, 301 fold(F, S, bitstr_val(T)), 302 bitstr_size(T)), 303 bitstr_unit(T)), 304 bitstr_type(T)), 305 bitstr_flags(T)); 306 letrec -> 307 fold(F, fold_pairs(F, S, letrec_defs(T)), letrec_body(T)); 308 module -> 309 fold_pairs(F, 310 fold_pairs(F, 311 fold_list(F, 312 fold(F, S, module_name(T)), 313 module_exports(T)), 314 module_attrs(T)), 315 module_defs(T)) 316 end. 317 318fold_list(F, S, [T | Ts]) -> 319 fold_list(F, fold(F, S, T), Ts); 320fold_list(_, S, []) -> 321 S. 322 323fold_pairs(F, S, [{T1, T2} | Ps]) -> 324 fold_pairs(F, fold(F, fold(F, S, T1), T2), Ps); 325fold_pairs(_, S, []) -> 326 S. 327 328 329%% @spec mapfold(Function, Initial::term(), Tree::cerl()) -> 330%% {cerl(), term()} 331%% 332%% Function = (cerl(), term()) -> {cerl(), term()} 333%% 334%% @doc Does a combined map/fold operation on the nodes of the 335%% tree. This is similar to <code>map/2</code>, but also propagates a 336%% value from each application of <code>Function</code> to the next, 337%% starting with the given value <code>Initial</code>, while doing a 338%% post-order traversal of the tree, much like <code>fold/3</code>. 339%% 340%% This is the same as mapfold/4, with an identity function as the 341%% pre-operation. 342%% 343%% @see map/2 344%% @see fold/3 345%% @see mapfold/4 346 347-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), 348 term(), cerl:cerl()) -> {cerl:cerl(), term()}. 349 350mapfold(F, S0, T) -> 351 mapfold(fun(T0, A) -> {T0, A} end, F, S0, T). 352 353 354%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> {cerl(), term()} 355%% Pre = (cerl(), term()) -> {cerl(), term()} | skip 356%% Post = (cerl(), term()) -> {cerl(), term()} 357%% 358%% @doc Does a combined map/fold operation on the nodes of the 359%% tree. It begins by calling <code>Pre</code> on the tree, using the 360%% <code>Initial</code> value. <code>Pre</code> must either return a 361%% tree with an updated accumulator or the atom <code>skip</code>. 362%% 363%% If a tree is returned, this function deconstructs the top node of 364%% the returned tree and recurses on the children, using the returned 365%% value as the new initial and carrying the returned values from one 366%% call to the next. Finally it reassembles the top node from the 367%% children, calls <code>Post</code> on it and returns the result. 368%% 369%% If <code>skip</code> is returned, it returns the tree and accumulator 370%% as is. 371 372-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()} | skip), 373 fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), 374 term(), cerl:cerl()) -> {cerl:cerl(), term()}. 375 376mapfold(Pre, Post, S00, T0) -> 377 case Pre(T0, S00) of 378 {T, S0} -> 379 case type(T) of 380 literal -> 381 case concrete(T) of 382 [_ | _] -> 383 {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)), 384 {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)), 385 Post(update_c_cons(T, T1, T2), S2); 386 V when tuple_size(V) > 0 -> 387 {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)), 388 Post(update_c_tuple(T, Ts), S1); 389 _ -> 390 Post(T, S0) 391 end; 392 var -> 393 Post(T, S0); 394 values -> 395 {Ts, S1} = mapfold_list(Pre, Post, S0, values_es(T)), 396 Post(update_c_values(T, Ts), S1); 397 cons -> 398 {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)), 399 {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)), 400 Post(update_c_cons_skel(T, T1, T2), S2); 401 tuple -> 402 {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)), 403 Post(update_c_tuple_skel(T, Ts), S1); 404 map -> 405 {M , S1} = mapfold(Pre, Post, S0, map_arg(T)), 406 {Ts, S2} = mapfold_list(Pre, Post, S1, map_es(T)), 407 Post(update_c_map(T, M, Ts), S2); 408 map_pair -> 409 {Op, S1} = mapfold(Pre, Post, S0, map_pair_op(T)), 410 {Key, S2} = mapfold(Pre, Post, S1, map_pair_key(T)), 411 {Val, S3} = mapfold(Pre, Post, S2, map_pair_val(T)), 412 Post(update_c_map_pair(T,Op,Key,Val), S3); 413 'let' -> 414 {Vs, S1} = mapfold_list(Pre, Post, S0, let_vars(T)), 415 {A, S2} = mapfold(Pre, Post, S1, let_arg(T)), 416 {B, S3} = mapfold(Pre, Post, S2, let_body(T)), 417 Post(update_c_let(T, Vs, A, B), S3); 418 seq -> 419 {A, S1} = mapfold(Pre, Post, S0, seq_arg(T)), 420 {B, S2} = mapfold(Pre, Post, S1, seq_body(T)), 421 Post(update_c_seq(T, A, B), S2); 422 apply -> 423 {E, S1} = mapfold(Pre, Post, S0, apply_op(T)), 424 {As, S2} = mapfold_list(Pre, Post, S1, apply_args(T)), 425 Post(update_c_apply(T, E, As), S2); 426 call -> 427 {M, S1} = mapfold(Pre, Post, S0, call_module(T)), 428 {N, S2} = mapfold(Pre, Post, S1, call_name(T)), 429 {As, S3} = mapfold_list(Pre, Post, S2, call_args(T)), 430 Post(update_c_call(T, M, N, As), S3); 431 primop -> 432 {N, S1} = mapfold(Pre, Post, S0, primop_name(T)), 433 {As, S2} = mapfold_list(Pre, Post, S1, primop_args(T)), 434 Post(update_c_primop(T, N, As), S2); 435 'case' -> 436 {A, S1} = mapfold(Pre, Post, S0, case_arg(T)), 437 {Cs, S2} = mapfold_list(Pre, Post, S1, case_clauses(T)), 438 Post(update_c_case(T, A, Cs), S2); 439 clause -> 440 {Ps, S1} = mapfold_list(Pre, Post, S0, clause_pats(T)), 441 {G, S2} = mapfold(Pre, Post, S1, clause_guard(T)), 442 {B, S3} = mapfold(Pre, Post, S2, clause_body(T)), 443 Post(update_c_clause(T, Ps, G, B), S3); 444 alias -> 445 {V, S1} = mapfold(Pre, Post, S0, alias_var(T)), 446 {P, S2} = mapfold(Pre, Post, S1, alias_pat(T)), 447 Post(update_c_alias(T, V, P), S2); 448 'fun' -> 449 {Vs, S1} = mapfold_list(Pre, Post, S0, fun_vars(T)), 450 {B, S2} = mapfold(Pre, Post, S1, fun_body(T)), 451 Post(update_c_fun(T, Vs, B), S2); 452 'receive' -> 453 {Cs, S1} = mapfold_list(Pre, Post, S0, receive_clauses(T)), 454 {E, S2} = mapfold(Pre, Post, S1, receive_timeout(T)), 455 {A, S3} = mapfold(Pre, Post, S2, receive_action(T)), 456 Post(update_c_receive(T, Cs, E, A), S3); 457 'try' -> 458 {E, S1} = mapfold(Pre, Post, S0, try_arg(T)), 459 {Vs, S2} = mapfold_list(Pre, Post, S1, try_vars(T)), 460 {B, S3} = mapfold(Pre, Post, S2, try_body(T)), 461 {Evs, S4} = mapfold_list(Pre, Post, S3, try_evars(T)), 462 {H, S5} = mapfold(Pre, Post, S4, try_handler(T)), 463 Post(update_c_try(T, E, Vs, B, Evs, H), S5); 464 'catch' -> 465 {B, S1} = mapfold(Pre, Post, S0, catch_body(T)), 466 Post(update_c_catch(T, B), S1); 467 binary -> 468 {Ds, S1} = mapfold_list(Pre, Post, S0, binary_segments(T)), 469 Post(update_c_binary(T, Ds), S1); 470 bitstr -> 471 {Val, S1} = mapfold(Pre, Post, S0, bitstr_val(T)), 472 {Size, S2} = mapfold(Pre, Post, S1, bitstr_size(T)), 473 {Unit, S3} = mapfold(Pre, Post, S2, bitstr_unit(T)), 474 {Type, S4} = mapfold(Pre, Post, S3, bitstr_type(T)), 475 {Flags, S5} = mapfold(Pre, Post, S4, bitstr_flags(T)), 476 Post(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); 477 letrec -> 478 {Ds, S1} = mapfold_pairs(Pre, Post, S0, letrec_defs(T)), 479 {B, S2} = mapfold(Pre, Post, S1, letrec_body(T)), 480 Post(update_c_letrec(T, Ds, B), S2); 481 module -> 482 {N, S1} = mapfold(Pre, Post, S0, module_name(T)), 483 {Es, S2} = mapfold_list(Pre, Post, S1, module_exports(T)), 484 {As, S3} = mapfold_pairs(Pre, Post, S2, module_attrs(T)), 485 {Ds, S4} = mapfold_pairs(Pre, Post, S3, module_defs(T)), 486 Post(update_c_module(T, N, Es, As, Ds), S4) 487 end; 488 skip -> 489 {T0, S00} 490 end. 491 492mapfold_list(Pre, Post, S0, [T | Ts]) -> 493 {T1, S1} = mapfold(Pre, Post, S0, T), 494 {Ts1, S2} = mapfold_list(Pre, Post, S1, Ts), 495 {[T1 | Ts1], S2}; 496mapfold_list(_, _, S, []) -> 497 {[], S}. 498 499mapfold_pairs(Pre, Post, S0, [{T1, T2} | Ps]) -> 500 {T3, S1} = mapfold(Pre, Post, S0, T1), 501 {T4, S2} = mapfold(Pre, Post, S1, T2), 502 {Ps1, S3} = mapfold_pairs(Pre, Post, S2, Ps), 503 {[{T3, T4} | Ps1], S3}; 504mapfold_pairs(_, _, S, []) -> 505 {[], S}. 506 507 508%% --------------------------------------------------------------------- 509 510%% @spec variables(Tree::cerl()) -> [var_name()] 511%% 512%% var_name() = integer() | atom() | {atom(), integer()} 513%% 514%% @doc Returns an ordered-set list of the names of all variables in 515%% the syntax tree. (This includes function name variables.) An 516%% exception is thrown if <code>Tree</code> does not represent a 517%% well-formed Core Erlang syntax tree. 518%% 519%% @see free_variables/1 520%% @see next_free_variable_name/1 521 522-spec variables(cerl:cerl()) -> [cerl:var_name()]. 523 524variables(T) -> 525 variables(T, false). 526 527 528%% @spec free_variables(Tree::cerl()) -> [var_name()] 529%% 530%% @doc Like <code>variables/1</code>, but only includes variables 531%% that are free in the tree. 532%% 533%% @see next_free_variable_name/1 534%% @see variables/1 535 536-spec free_variables(cerl:cerl()) -> [cerl:var_name()]. 537 538free_variables(T) -> 539 variables(T, true). 540 541 542%% This is not exported 543 544variables(T, S) -> 545 case type(T) of 546 literal -> 547 []; 548 var -> 549 [var_name(T)]; 550 values -> 551 vars_in_list(values_es(T), S); 552 cons -> 553 ordsets:union(variables(cons_hd(T), S), 554 variables(cons_tl(T), S)); 555 tuple -> 556 vars_in_list(tuple_es(T), S); 557 map -> 558 vars_in_list([map_arg(T)|map_es(T)], S); 559 map_pair -> 560 vars_in_list([map_pair_op(T),map_pair_key(T),map_pair_val(T)], S); 561 'let' -> 562 Vs = variables(let_body(T), S), 563 Vs1 = var_list_names(let_vars(T)), 564 Vs2 = case S of 565 true -> 566 ordsets:subtract(Vs, Vs1); 567 false -> 568 ordsets:union(Vs, Vs1) 569 end, 570 ordsets:union(variables(let_arg(T), S), Vs2); 571 seq -> 572 ordsets:union(variables(seq_arg(T), S), 573 variables(seq_body(T), S)); 574 apply -> 575 ordsets:union( 576 variables(apply_op(T), S), 577 vars_in_list(apply_args(T), S)); 578 call -> 579 ordsets:union(variables(call_module(T), S), 580 ordsets:union( 581 variables(call_name(T), S), 582 vars_in_list(call_args(T), S))); 583 primop -> 584 vars_in_list(primop_args(T), S); 585 'case' -> 586 ordsets:union(variables(case_arg(T), S), 587 vars_in_list(case_clauses(T), S)); 588 clause -> 589 Vs = ordsets:union(variables(clause_guard(T), S), 590 variables(clause_body(T), S)), 591 Vs1 = vars_in_list(clause_pats(T), S), 592 case S of 593 true -> 594 ordsets:subtract(Vs, Vs1); 595 false -> 596 ordsets:union(Vs, Vs1) 597 end; 598 alias -> 599 ordsets:add_element(var_name(alias_var(T)), 600 variables(alias_pat(T))); 601 'fun' -> 602 Vs = variables(fun_body(T), S), 603 Vs1 = var_list_names(fun_vars(T)), 604 case S of 605 true -> 606 ordsets:subtract(Vs, Vs1); 607 false -> 608 ordsets:union(Vs, Vs1) 609 end; 610 'receive' -> 611 ordsets:union( 612 vars_in_list(receive_clauses(T), S), 613 ordsets:union(variables(receive_timeout(T), S), 614 variables(receive_action(T), S))); 615 'try' -> 616 Vs = variables(try_body(T), S), 617 Vs1 = var_list_names(try_vars(T)), 618 Vs2 = case S of 619 true -> 620 ordsets:subtract(Vs, Vs1); 621 false -> 622 ordsets:union(Vs, Vs1) 623 end, 624 Vs3 = variables(try_handler(T), S), 625 Vs4 = var_list_names(try_evars(T)), 626 Vs5 = case S of 627 true -> 628 ordsets:subtract(Vs3, Vs4); 629 false -> 630 ordsets:union(Vs3, Vs4) 631 end, 632 ordsets:union(variables(try_arg(T), S), 633 ordsets:union(Vs2, Vs5)); 634 'catch' -> 635 variables(catch_body(T), S); 636 binary -> 637 vars_in_list(binary_segments(T), S); 638 bitstr -> 639 ordsets:union(variables(bitstr_val(T), S), 640 variables(bitstr_size(T), S)); 641 letrec -> 642 Vs = vars_in_defs(letrec_defs(T), S), 643 Vs1 = ordsets:union(variables(letrec_body(T), S), Vs), 644 Vs2 = var_list_names(letrec_vars(T)), 645 case S of 646 true -> 647 ordsets:subtract(Vs1, Vs2); 648 false -> 649 ordsets:union(Vs1, Vs2) 650 end; 651 module -> 652 Vs = vars_in_defs(module_defs(T), S), 653 Vs1 = ordsets:union(vars_in_list(module_exports(T), S), Vs), 654 Vs2 = var_list_names(module_vars(T)), 655 case S of 656 true -> 657 ordsets:subtract(Vs1, Vs2); 658 false -> 659 ordsets:union(Vs1, Vs2) 660 end 661 end. 662 663vars_in_list(Ts, S) -> 664 vars_in_list(Ts, S, []). 665 666vars_in_list([T | Ts], S, A) -> 667 vars_in_list(Ts, S, ordsets:union(variables(T, S), A)); 668vars_in_list([], _, A) -> 669 A. 670 671%% Note that this function only visits the right-hand side of function 672%% definitions. 673 674vars_in_defs(Ds, S) -> 675 vars_in_defs(Ds, S, []). 676 677vars_in_defs([{_, Post} | Ds], S, A) -> 678 vars_in_defs(Ds, S, ordsets:union(variables(Post, S), A)); 679vars_in_defs([], _, A) -> 680 A. 681 682%% This amounts to insertion sort. Since the lists are generally short, 683%% it is hardly worthwhile to use an asymptotically better sort. 684 685var_list_names(Vs) -> 686 var_list_names(Vs, []). 687 688var_list_names([V | Vs], A) -> 689 var_list_names(Vs, ordsets:add_element(var_name(V), A)); 690var_list_names([], A) -> 691 A. 692 693%% --------------------------------------------------------------------- 694 695%% @spec next_free_variable_name(Tree::cerl()) -> var_name() 696%% 697%% var_name() = integer() 698%% 699%% @doc Returns a integer variable name higher than any other integer 700%% variable name in the syntax tree. An exception is thrown if 701%% <code>Tree</code> does not represent a well-formed Core Erlang 702%% syntax tree. 703%% 704%% @see variables/1 705%% @see free_variables/1 706 707-spec next_free_variable_name(cerl:cerl()) -> integer(). 708 709next_free_variable_name(T) -> 710 1 + next_free(T, -1). 711 712next_free(T, Max) -> 713 case type(T) of 714 literal -> 715 Max; 716 var -> 717 case var_name(T) of 718 Int when is_integer(Int) -> 719 max(Int, Max); 720 _ -> 721 Max 722 end; 723 values -> 724 next_free_in_list(values_es(T), Max); 725 cons -> 726 next_free(cons_hd(T), next_free(cons_tl(T), Max)); 727 tuple -> 728 next_free_in_list(tuple_es(T), Max); 729 map -> 730 next_free_in_list([map_arg(T)|map_es(T)], Max); 731 map_pair -> 732 next_free_in_list([map_pair_op(T),map_pair_key(T), 733 map_pair_val(T)], Max); 734 'let' -> 735 Max1 = next_free(let_body(T), Max), 736 Max2 = next_free_in_list(let_vars(T), Max1), 737 next_free(let_arg(T), Max2); 738 seq -> 739 next_free(seq_arg(T), 740 next_free(seq_body(T), Max)); 741 apply -> 742 next_free(apply_op(T), 743 next_free_in_list(apply_args(T), Max)); 744 call -> 745 next_free(call_module(T), 746 next_free(call_name(T), 747 next_free_in_list( 748 call_args(T), Max))); 749 primop -> 750 next_free_in_list(primop_args(T), Max); 751 'case' -> 752 next_free(case_arg(T), 753 next_free_in_list(case_clauses(T), Max)); 754 clause -> 755 Max1 = next_free(clause_guard(T), 756 next_free(clause_body(T), Max)), 757 next_free_in_list(clause_pats(T), Max1); 758 alias -> 759 next_free(alias_var(T), 760 next_free(alias_pat(T), Max)); 761 'fun' -> 762 next_free(fun_body(T), 763 next_free_in_list(fun_vars(T), Max)); 764 'receive' -> 765 Max1 = next_free_in_list(receive_clauses(T), 766 next_free(receive_timeout(T), Max)), 767 next_free(receive_action(T), Max1); 768 'try' -> 769 Max1 = next_free(try_body(T), Max), 770 Max2 = next_free_in_list(try_vars(T), Max1), 771 Max3 = next_free(try_handler(T), Max2), 772 Max4 = next_free_in_list(try_evars(T), Max3), 773 next_free(try_arg(T), Max4); 774 'catch' -> 775 next_free(catch_body(T), Max); 776 binary -> 777 next_free_in_list(binary_segments(T), Max); 778 bitstr -> 779 next_free(bitstr_val(T), next_free(bitstr_size(T), Max)); 780 letrec -> 781 Max1 = next_free_in_defs(letrec_defs(T), Max), 782 Max2 = next_free(letrec_body(T), Max1), 783 next_free_in_list(letrec_vars(T), Max2); 784 module -> 785 next_free_in_defs(module_defs(T), Max) 786 end. 787 788next_free_in_list([H | T], Max) -> 789 next_free_in_list(T, next_free(H, Max)); 790next_free_in_list([], Max) -> 791 Max. 792 793next_free_in_defs([{_, Post} | Ds], Max) -> 794 next_free_in_defs(Ds, next_free(Post, Max)); 795next_free_in_defs([], Max) -> 796 Max. 797 798%% --------------------------------------------------------------------- 799 800%% label(Tree::cerl()) -> {cerl(), integer()} 801%% 802%% @equiv label(Tree, 0) 803 804-spec label(cerl:cerl()) -> {cerl:cerl(), integer()}. 805 806label(T) -> 807 label(T, 0). 808 809%% @spec label(Tree::cerl(), N::integer()) -> {cerl(), integer()} 810%% 811%% @doc Labels each expression in the tree. A term <code>{label, 812%% L}</code> is prefixed to the annotation list of each expression node, 813%% where L is a unique number for every node, except for variables (and 814%% function name variables) which get the same label if they represent 815%% the same variable. Constant literal nodes are not labeled. 816%% 817%% <p>The returned value is a tuple <code>{NewTree, Max}</code>, where 818%% <code>NewTree</code> is the labeled tree and <code>Max</code> is 1 819%% plus the largest label value used. All previous annotation terms on 820%% the form <code>{label, X}</code> are deleted.</p> 821%% 822%% <p>The values of L used in the tree is a dense range from 823%% <code>N</code> to <code>Max - 1</code>, where <code>N =< Max 824%% =< N + size(Tree)</code>. Note that it is possible that no 825%% labels are used at all, i.e., <code>N = Max</code>.</p> 826%% 827%% <p>Note: All instances of free variables will be given distinct 828%% labels.</p> 829%% 830%% @see label/1 831%% @see size/1 832 833-spec label(cerl:cerl(), integer()) -> {cerl:cerl(), integer()}. 834 835label(T, N) -> 836 label(T, N, #{}). 837 838label(T, N, Env) -> 839 case type(T) of 840 literal -> 841 %% Constant literals are not labeled. 842 {T, N}; 843 var -> 844 VarName = var_name(T), 845 {As, N1} = 846 case Env of 847 #{VarName := L} -> 848 {A, _} = label_ann(T, L), 849 {A, N}; 850 #{} -> 851 label_ann(T, N) 852 end, 853 {set_ann(T, As), N1}; 854 values -> 855 {Ts, N1} = label_list(values_es(T), N, Env), 856 {As, N2} = label_ann(T, N1), 857 {ann_c_values(As, Ts), N2}; 858 cons -> 859 {T1, N1} = label(cons_hd(T), N, Env), 860 {T2, N2} = label(cons_tl(T), N1, Env), 861 {As, N3} = label_ann(T, N2), 862 {ann_c_cons_skel(As, T1, T2), N3}; 863 tuple -> 864 {Ts, N1} = label_list(tuple_es(T), N, Env), 865 {As, N2} = label_ann(T, N1), 866 {ann_c_tuple_skel(As, Ts), N2}; 867 map -> 868 case is_c_map_pattern(T) of 869 false -> 870 {M, N1} = label(map_arg(T), N, Env), 871 {Ts, N2} = label_list(map_es(T), N1, Env), 872 {As, N3} = label_ann(T, N2), 873 {ann_c_map(As, M, Ts), N3}; 874 true -> 875 {Ts, N1} = label_list(map_es(T), N, Env), 876 {As, N2} = label_ann(T, N1), 877 {ann_c_map_pattern(As, Ts), N2} 878 end; 879 map_pair -> 880 {Op, N1} = label(map_pair_op(T), N, Env), 881 {Key, N2} = label(map_pair_key(T), N1, Env), 882 {Val, N3} = label(map_pair_val(T), N2, Env), 883 {As, N4} = label_ann(T, N3), 884 {ann_c_map_pair(As,Op,Key,Val), N4}; 885 'let' -> 886 {A, N1} = label(let_arg(T), N, Env), 887 {Vs, N2, Env1} = label_vars(let_vars(T), N1, Env), 888 {B, N3} = label(let_body(T), N2, Env1), 889 {As, N4} = label_ann(T, N3), 890 {ann_c_let(As, Vs, A, B), N4}; 891 seq -> 892 {A, N1} = label(seq_arg(T), N, Env), 893 {B, N2} = label(seq_body(T), N1, Env), 894 {As, N3} = label_ann(T, N2), 895 {ann_c_seq(As, A, B), N3}; 896 apply -> 897 {E, N1} = label(apply_op(T), N, Env), 898 {Es, N2} = label_list(apply_args(T), N1, Env), 899 {As, N3} = label_ann(T, N2), 900 {ann_c_apply(As, E, Es), N3}; 901 call -> 902 {M, N1} = label(call_module(T), N, Env), 903 {F, N2} = label(call_name(T), N1, Env), 904 {Es, N3} = label_list(call_args(T), N2, Env), 905 {As, N4} = label_ann(T, N3), 906 {ann_c_call(As, M, F, Es), N4}; 907 primop -> 908 {F, N1} = label(primop_name(T), N, Env), 909 {Es, N2} = label_list(primop_args(T), N1, Env), 910 {As, N3} = label_ann(T, N2), 911 {ann_c_primop(As, F, Es), N3}; 912 'case' -> 913 {A, N1} = label(case_arg(T), N, Env), 914 {Cs, N2} = label_list(case_clauses(T), N1, Env), 915 {As, N3} = label_ann(T, N2), 916 {ann_c_case(As, A, Cs), N3}; 917 clause -> 918 {_, N1, Env1} = label_vars(clause_vars(T), N, Env), 919 {Ps, N2} = label_list(clause_pats(T), N1, Env1), 920 {G, N3} = label(clause_guard(T), N2, Env1), 921 {B, N4} = label(clause_body(T), N3, Env1), 922 {As, N5} = label_ann(T, N4), 923 {ann_c_clause(As, Ps, G, B), N5}; 924 alias -> 925 {V, N1} = label(alias_var(T), N, Env), 926 {P, N2} = label(alias_pat(T), N1, Env), 927 {As, N3} = label_ann(T, N2), 928 {ann_c_alias(As, V, P), N3}; 929 'fun' -> 930 {Vs, N1, Env1} = label_vars(fun_vars(T), N, Env), 931 {B, N2} = label(fun_body(T), N1, Env1), 932 {As, N3} = label_ann(T, N2), 933 {ann_c_fun(As, Vs, B), N3}; 934 'receive' -> 935 {Cs, N1} = label_list(receive_clauses(T), N, Env), 936 {E, N2} = label(receive_timeout(T), N1, Env), 937 {A, N3} = label(receive_action(T), N2, Env), 938 {As, N4} = label_ann(T, N3), 939 {ann_c_receive(As, Cs, E, A), N4}; 940 'try' -> 941 {E, N1} = label(try_arg(T), N, Env), 942 {Vs, N2, Env1} = label_vars(try_vars(T), N1, Env), 943 {B, N3} = label(try_body(T), N2, Env1), 944 {Evs, N4, Env2} = label_vars(try_evars(T), N3, Env), 945 {H, N5} = label(try_handler(T), N4, Env2), 946 {As, N6} = label_ann(T, N5), 947 {ann_c_try(As, E, Vs, B, Evs, H), N6}; 948 'catch' -> 949 {B, N1} = label(catch_body(T), N, Env), 950 {As, N2} = label_ann(T, N1), 951 {ann_c_catch(As, B), N2}; 952 binary -> 953 {Ds, N1} = label_list(binary_segments(T), N, Env), 954 {As, N2} = label_ann(T, N1), 955 {ann_c_binary(As, Ds), N2}; 956 bitstr -> 957 {Val, N1} = label(bitstr_val(T), N, Env), 958 {Size, N2} = label(bitstr_size(T), N1, Env), 959 {Unit, N3} = label(bitstr_unit(T), N2, Env), 960 {Type, N4} = label(bitstr_type(T), N3, Env), 961 {Flags, N5} = label(bitstr_flags(T), N4, Env), 962 {As, N6} = label_ann(T, N5), 963 {ann_c_bitstr(As, Val, Size, Unit, Type, Flags), N6}; 964 letrec -> 965 {_, N1, Env1} = label_vars(letrec_vars(T), N, Env), 966 {Ds, N2} = label_defs(letrec_defs(T), N1, Env1), 967 {B, N3} = label(letrec_body(T), N2, Env1), 968 {As, N4} = label_ann(T, N3), 969 {ann_c_letrec(As, Ds, B), N4}; 970 module -> 971 %% The module name is not labeled. 972 {_, N1, Env1} = label_vars(module_vars(T), N, Env), 973 {Ts, N2} = label_defs(module_attrs(T), N1, Env1), 974 {Ds, N3} = label_defs(module_defs(T), N2, Env1), 975 {Es, N4} = label_list(module_exports(T), N3, Env1), 976 {As, N5} = label_ann(T, N4), 977 {ann_c_module(As, module_name(T), Es, Ts, Ds), N5} 978 end. 979 980label_list([T | Ts], N, Env) -> 981 {T1, N1} = label(T, N, Env), 982 {Ts1, N2} = label_list(Ts, N1, Env), 983 {[T1 | Ts1], N2}; 984label_list([], N, _Env) -> 985 {[], N}. 986 987label_vars([T | Ts], N, Env) -> 988 Env1 = Env#{var_name(T) => N}, 989 {As, N1} = label_ann(T, N), 990 T1 = set_ann(T, As), 991 {Ts1, N2, Env2} = label_vars(Ts, N1, Env1), 992 {[T1 | Ts1], N2, Env2}; 993label_vars([], N, Env) -> 994 {[], N, Env}. 995 996label_defs([{F, T} | Ds], N, Env) -> 997 {F1, N1} = label(F, N, Env), 998 {T1, N2} = label(T, N1, Env), 999 {Ds1, N3} = label_defs(Ds, N2, Env), 1000 {[{F1, T1} | Ds1], N3}; 1001label_defs([], N, _Env) -> 1002 {[], N}. 1003 1004label_ann(T, N) -> 1005 {[{label, N} | filter_labels(get_ann(T))], N + 1}. 1006 1007filter_labels([{label, _} | As]) -> 1008 filter_labels(As); 1009filter_labels([A | As]) -> 1010 [A | filter_labels(As)]; 1011filter_labels([]) -> 1012 []. 1013 1014-spec get_label(cerl:cerl()) -> 'top' | integer(). 1015 1016get_label(T) -> 1017 case get_ann(T) of 1018 [{label, L} | _] -> L; 1019 _ -> throw({missing_label, T}) 1020 end. 1021