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 2001-2002 Richard Carlsson 14%% @author Richard Carlsson <carlsson.richard@gmail.com> 15%% @doc Closure analysis of Core Erlang programs. 16 17%% TODO: might need a "top" (`any') element for any-length value lists. 18 19-module(cerl_closurean). 20 21-export([analyze/1, annotate/1]). 22%% The following functions are exported from this module since they 23%% are also used by Dialyzer (file dialyzer/src/dialyzer_dep.erl) 24-export([is_escape_op/2, is_escape_op/3, is_literal_op/2, is_literal_op/3]). 25 26-import(cerl, [ann_c_apply/3, ann_c_fun/3, ann_c_var/2, apply_args/1, 27 apply_op/1, atom_val/1, bitstr_size/1, bitstr_val/1, 28 binary_segments/1, c_letrec/2, c_seq/2, c_tuple/1, 29 c_nil/0, call_args/1, call_module/1, call_name/1, 30 case_arg/1, case_clauses/1, catch_body/1, clause_body/1, 31 clause_guard/1, clause_pats/1, cons_hd/1, cons_tl/1, 32 fun_body/1, fun_vars/1, get_ann/1, is_c_atom/1, 33 let_arg/1, let_body/1, let_vars/1, letrec_body/1, 34 letrec_defs/1, module_defs/1, module_defs/1, 35 module_exports/1, pat_vars/1, primop_args/1, 36 primop_name/1, receive_action/1, receive_clauses/1, 37 receive_timeout/1, seq_arg/1, seq_body/1, set_ann/2, 38 try_arg/1, try_body/1, try_vars/1, try_evars/1, 39 try_handler/1, tuple_es/1, type/1, values_es/1]). 40 41-import(cerl_trees, [get_label/1]). 42 43%% =========================================================================== 44 45-type label() :: integer() | 'top' | 'external' | 'external_call'. 46-type ordset(X) :: [X]. % XXX: TAKE ME OUT 47-type labelset() :: ordset(label()). 48-type outlist() :: [labelset()] | 'none'. 49-type escapes() :: labelset(). 50 51%% =========================================================================== 52%% annotate(Tree) -> {Tree1, OutList, Outputs, Escapes, Dependencies, Parents} 53%% 54%% Tree = cerl:cerl() 55%% 56%% Analyzes `Tree' (see `analyze') and appends terms `{callers, 57%% Labels}' and `{calls, Labels}' to the annotation list of each 58%% fun-expression node and apply-expression node of `Tree', 59%% respectively, where `Labels' is an ordered-set list of labels of 60%% fun-expressions in `Tree', possibly also containing the atom 61%% `external', corresponding to the dependency information derived 62%% by the analysis. Any previous such annotations are removed from 63%% `Tree'. `Tree1' is the modified tree; for details on `OutList', 64%% `Outputs' , `Dependencies', `Escapes' and `Parents', see 65%% `analyze'. 66%% 67%% Note: `Tree' must be annotated with labels in order to use this 68%% function; see `analyze' for details. 69 70-spec annotate(cerl:cerl()) -> 71 {cerl:cerl(), outlist(), dict:dict(), 72 escapes(), dict:dict(), dict:dict()}. 73 74annotate(Tree) -> 75 {Xs, Out, Esc, Deps, Par} = analyze(Tree), 76 F = fun (T) -> 77 case type(T) of 78 'fun' -> 79 L = get_label(T), 80 X = case dict:find(L, Deps) of 81 {ok, X1} -> X1; 82 error -> set__new() 83 end, 84 set_ann(T, append_ann(callers, 85 set__to_list(X), 86 get_ann(T))); 87 apply -> 88 L = get_label(T), 89 X = case dict:find(L, Deps) of 90 {ok, X1} -> X1; 91 error -> set__new() 92 end, 93 set_ann(T, append_ann(calls, 94 set__to_list(X), 95 get_ann(T))); 96 _ -> 97%%% set_ann(T, []) % debug 98 T 99 end 100 end, 101 {cerl_trees:map(F, Tree), Xs, Out, Esc, Deps, Par}. 102 103append_ann(Tag, Val, [X | Xs]) -> 104 if tuple_size(X) >= 1, element(1, X) =:= Tag -> 105 append_ann(Tag, Val, Xs); 106 true -> 107 [X | append_ann(Tag, Val, Xs)] 108 end; 109append_ann(Tag, Val, []) -> 110 [{Tag, Val}]. 111 112%% ===================================================================== 113%% analyze(Tree) -> {OutList, Outputs, Escapes, Dependencies, Parents} 114%% 115%% Tree = cerl() 116%% OutList = [LabelSet] | none 117%% Outputs = dict(Label, OutList) 118%% Escapes = LabelSet 119%% Dependencies = dict(Label, LabelSet) 120%% LabelSet = ordset(Label) 121%% Label = integer() | top | external | external_call 122%% Parents = dict(Label, Label) 123%% 124%% Analyzes a module or an expression represented by `Tree'. 125%% 126%% The returned `OutList' is a list of sets of labels of 127%% fun-expressions which correspond to the possible closures in the 128%% value list produced by `Tree' (viewed as an expression; the 129%% "value" of a module contains its exported functions). The atom 130%% `none' denotes missing or conflicting information. 131%% 132%% The atom `external' in any label set denotes any possible 133%% function outside `Tree', including those in `Escapes'. The atom 134%% `top' denotes the top-level expression `Tree'. 135%% 136%% `Outputs' is a mapping from the labels of fun-expressions in 137%% `Tree' to corresponding lists of sets of labels of 138%% fun-expressions (or the atom `none'), representing the possible 139%% closures in the value lists returned by the respective 140%% functions. 141%% 142%% `Dependencies' is a similar mapping from the labels of 143%% fun-expressions and apply-expressions in `Tree' to sets of 144%% labels of corresponding fun-expressions which may contain call 145%% sites of the functions or be called from the call sites, 146%% respectively. Any such label not defined in `Dependencies' 147%% represents an unreachable function or a dead or faulty 148%% application. 149%% 150%% `Escapes' is the set of labels of fun-expressions in `Tree' such 151%% that corresponding closures may be accessed from outside `Tree'. 152%% 153%% `Parents' is a mapping from labels of fun-expressions in `Tree' 154%% to the corresponding label of the nearest containing 155%% fun-expression or top-level expression. This can be used to 156%% extend the dependency graph, for certain analyses. 157%% 158%% Note: `Tree' must be annotated with labels (as done by the 159%% function `cerl_trees:label/1') in order to use this function. 160%% The label annotation `{label, L}' (where L should be an integer) 161%% must be the first element of the annotation list of each node in 162%% the tree. Instances of variables bound in `Tree' which denote 163%% the same variable must have the same label; apart from this, 164%% labels should be unique. Constant literals do not need to be 165%% labeled. 166 167-record(state, {vars, out, dep, work, funs, par}). 168 169%% Note: In order to keep our domain simple, we assume that all remote 170%% calls and primops return a single value, if any. 171 172%% We use the terms `closure', `label', `lambda' and `fun-expression' 173%% interchangeably. The exact meaning in each case can be grasped from 174%% the context. 175%% 176%% Rules: 177%% 1) The implicit top level lambda escapes. 178%% 2) A lambda returned by an escaped lambda also escapes. 179%% 3) An escaped lambda can be passed an external lambda as argument. 180%% 4) A lambda passed as argument to an external lambda also escapes. 181%% 5) An argument passed to an unknown operation escapes. 182%% 6) A call to an unknown operation can return an external lambda. 183%% 184%% Escaped lambdas become part of the set of external lambdas, but this 185%% does not need to be represented explicitly. 186 187%% We wrap the given syntax tree T in a fun-expression labeled `top', 188%% which is initially in the set of escaped labels. `top' will be 189%% visited at least once. 190%% 191%% We create a separate function labeled `external', defined as: 192%% "'external'/1 = fun (Escape) -> do apply 'external'/1(apply Escape()) 193%% 'external'/1", which will represent any and all functions outside T, 194%% and which returns itself, and contains a recursive call; this models 195%% rules 2 and 4 above. It will be revisited if the set of escaped 196%% labels changes, or at least once. Its parameter `Escape' is a 197%% variable labeled `escape', which will hold the set of escaped labels. 198%% initially it contains `top' and `external'. 199 200-spec analyze(cerl:cerl()) -> 201 {outlist(), dict:dict(), escapes(), dict:dict(), dict:dict()}. 202 203analyze(Tree) -> 204 %% Note that we use different name spaces for variable labels and 205 %% function/call site labels, so we can reuse some names here. We 206 %% assume that the labeling of Tree only uses integers, not atoms. 207 External = ann_c_var([{label, external}], {external, 1}), 208 Escape = ann_c_var([{label, escape}], 'Escape'), 209 ExtBody = c_seq(ann_c_apply([{label, loop}], External, 210 [ann_c_apply([{label, external_call}], 211 Escape, [])]), 212 External), 213 ExtFun = ann_c_fun([{label, external}], [Escape], ExtBody), 214%%% io:fwrite("external fun:\n~s.\n", 215%%% [cerl_prettypr:format(ExtFun, [noann])]), 216 Top = ann_c_var([{label, top}], {top, 0}), 217 TopFun = ann_c_fun([{label, top}], [], Tree), 218 219 %% The "start fun" just makes the initialisation easier. It will not 220 %% be marked as escaped, and thus cannot be called. 221 StartFun = ann_c_fun([{label, start}], [], 222 c_letrec([{External, ExtFun}, {Top, TopFun}], 223 c_nil())), 224%%% io:fwrite("start fun:\n~s.\n", 225%%% [cerl_prettypr:format(StartFun, [noann])]), 226 227 %% Gather a database of all fun-expressions in Tree and initialise 228 %% all their outputs and parameter variables. Bind all module- and 229 %% letrec-defined variables to their corresponding labels. 230 Funs0 = dict:new(), 231 Vars0 = dict:new(), 232 Out0 = dict:new(), 233 Empty = empty(), 234 F = fun (T, S = {Fs, Vs, Os}) -> 235 case type(T) of 236 'fun' -> 237 L = get_label(T), 238 As = fun_vars(T), 239 {dict:store(L, T, Fs), 240 bind_vars_single(As, Empty, Vs), 241 dict:store(L, none, Os)}; 242 letrec -> 243 {Fs, bind_defs(letrec_defs(T), Vs), Os}; 244 module -> 245 {Fs, bind_defs(module_defs(T), Vs), Os}; 246 _ -> 247 S 248 end 249 end, 250 {Funs, Vars, Out} = cerl_trees:fold(F, {Funs0, Vars0, Out0}, 251 StartFun), 252 253 %% Initialise Escape to the minimal set of escaped labels. 254 Vars1 = dict:store(escape, from_label_list([top, external]), Vars), 255 256 %% Enter the fixpoint iteration at the StartFun. 257 St = loop(StartFun, start, #state{vars = Vars1, 258 out = Out, 259 dep = dict:new(), 260 work = init_work(), 261 funs = Funs, 262 par = dict:new()}), 263%%% io:fwrite("dependencies: ~p.\n", 264%%% [[{X, set__to_list(Y)} 265%%% || {X, Y} <- dict:to_list(St#state.dep)]]), 266 {dict:fetch(top, St#state.out), 267 tidy_dict([start, top, external], St#state.out), 268 dict:fetch(escape, St#state.vars), 269 tidy_dict([loop], St#state.dep), 270 St#state.par}. 271 272tidy_dict([X | Xs], D) -> 273 tidy_dict(Xs, dict:erase(X, D)); 274tidy_dict([], D) -> 275 D. 276 277loop(T, L, St0) -> 278%%% io:fwrite("analyzing: ~w.\n", [L]), 279%%% io:fwrite("work: ~w.\n", [St0#state.work]), 280 Xs0 = dict:fetch(L, St0#state.out), 281 {Xs, St1} = visit(fun_body(T), L, St0), 282 {W, M} = case equal(Xs0, Xs) of 283 true -> 284 {St1#state.work, St1#state.out}; 285 false -> 286%%% io:fwrite("out (~w) changed: ~w <- ~w.\n", 287%%% [L, Xs, Xs0]), 288 M1 = dict:store(L, Xs, St1#state.out), 289 case dict:find(L, St1#state.dep) of 290 {ok, S} -> 291 {add_work(set__to_list(S), St1#state.work), 292 M1}; 293 error -> 294 {St1#state.work, M1} 295 end 296 end, 297 St2 = St1#state{out = M}, 298 case take_work(W) of 299 {ok, L1, W1} -> 300 T1 = dict:fetch(L1, St2#state.funs), 301 loop(T1, L1, St2#state{work = W1}); 302 none -> 303 St2 304 end. 305 306visit(T, L, St) -> 307 case type(T) of 308 literal -> 309 {[empty()], St}; 310 var -> 311 %% If a variable is not already in the store here, we 312 %% initialize it to empty(). 313 L1 = get_label(T), 314 Vars = St#state.vars, 315 case dict:find(L1, Vars) of 316 {ok, X} -> 317 {[X], St}; 318 error -> 319 X = empty(), 320 St1 = St#state{vars = dict:store(L1, X, Vars)}, 321 {[X], St1} 322 end; 323 'fun' -> 324 %% Must revisit the fun also, because its environment might 325 %% have changed. (We don't keep track of such dependencies.) 326 L1 = get_label(T), 327 St1 = St#state{work = add_work([L1], St#state.work), 328 par = set_parent([L1], L, St#state.par)}, 329 {[singleton(L1)], St1}; 330 values -> 331 visit_list(values_es(T), L, St); 332 cons -> 333 {Xs, St1} = visit_list([cons_hd(T), cons_tl(T)], L, St), 334 {[join_single_list(Xs)], St1}; 335 tuple -> 336 {Xs, St1} = visit_list(tuple_es(T), L, St), 337 {[join_single_list(Xs)], St1}; 338 'let' -> 339 {Xs, St1} = visit(let_arg(T), L, St), 340 Vars = bind_vars(let_vars(T), Xs, St1#state.vars), 341 visit(let_body(T), L, St1#state{vars = Vars}); 342 seq -> 343 {_, St1} = visit(seq_arg(T), L, St), 344 visit(seq_body(T), L, St1); 345 apply -> 346 {Xs, St1} = visit(apply_op(T), L, St), 347 {As, St2} = visit_list(apply_args(T), L, St1), 348 case Xs of 349 [X] -> 350 %% We store the dependency from the call site to the 351 %% called functions 352 Ls = set__to_list(X), 353 Out = St2#state.out, 354 Xs1 = join_list([dict:fetch(Lx, Out) || Lx <- Ls]), 355 St3 = call_site(Ls, L, As, St2), 356 L1 = get_label(T), 357 D = dict:store(L1, X, St3#state.dep), 358 {Xs1, St3#state{dep = D}}; 359 none -> 360 {none, St2} 361 end; 362 call -> 363 M = call_module(T), 364 F = call_name(T), 365 {_, St1} = visit(M, L, St), 366 {_, St2} = visit(F, L, St1), 367 {Xs, St3} = visit_list(call_args(T), L, St2), 368 remote_call(M, F, Xs, St3); 369 primop -> 370 As = primop_args(T), 371 {Xs, St1} = visit_list(As, L, St), 372 primop_call(atom_val(primop_name(T)), length(Xs), Xs, St1); 373 'case' -> 374 {Xs, St1} = visit(case_arg(T), L, St), 375 visit_clauses(Xs, case_clauses(T), L, St1); 376 'receive' -> 377 X = singleton(external), 378 {Xs1, St1} = visit_clauses([X], receive_clauses(T), L, St), 379 {_, St2} = visit(receive_timeout(T), L, St1), 380 {Xs2, St3} = visit(receive_action(T), L, St2), 381 {join(Xs1, Xs2), St3}; 382 'try' -> 383 {Xs1, St1} = visit(try_arg(T), L, St), 384 X = singleton(external), 385 Vars = bind_vars(try_vars(T), [X], St1#state.vars), 386 {Xs2, St2} = visit(try_body(T), L, St1#state{vars = Vars}), 387 Evars = bind_vars(try_evars(T), [X, X, X], St2#state.vars), 388 {Xs3, St3} = visit(try_handler(T), L, St2#state{vars = Evars}), 389 {join(join(Xs1, Xs2), Xs3), St3}; 390 'catch' -> 391 {_, St1} = visit(catch_body(T), L, St), 392 {[singleton(external)], St1}; 393 binary -> 394 {_, St1} = visit_list(binary_segments(T), L, St), 395 {[empty()], St1}; 396 bitstr -> 397 %% The other fields are constant literals. 398 {_, St1} = visit(bitstr_val(T), L, St), 399 {_, St2} = visit(bitstr_size(T), L, St1), 400 {none, St2}; 401 letrec -> 402 %% All the bound funs should be revisited, because the 403 %% environment might have changed. 404 Ls = [get_label(F) || {_, F} <- letrec_defs(T)], 405 St1 = St#state{work = add_work(Ls, St#state.work), 406 par = set_parent(Ls, L, St#state.par)}, 407 visit(letrec_body(T), L, St1); 408 module -> 409 %% All the exported functions escape, and can thus be passed 410 %% any external closures as arguments. We regard a module as 411 %% a tuple of function variables in the body of a `letrec'. 412 visit(c_letrec(module_defs(T), c_tuple(module_exports(T))), 413 L, St) 414 end. 415 416visit_clause(T, Xs, L, St) -> 417 Vars = bind_pats(clause_pats(T), Xs, St#state.vars), 418 {_, St1} = visit(clause_guard(T), L, St#state{vars = Vars}), 419 visit(clause_body(T), L, St1). 420 421%% We assume correct value-list typing. 422 423visit_list([T | Ts], L, St) -> 424 {Xs, St1} = visit(T, L, St), 425 {Xs1, St2} = visit_list(Ts, L, St1), 426 X = case Xs of 427 [X1] -> X1; 428 none -> none 429 end, 430 {[X | Xs1], St2}; 431visit_list([], _L, St) -> 432 {[], St}. 433 434visit_clauses(Xs, [T | Ts], L, St) -> 435 {Xs1, St1} = visit_clause(T, Xs, L, St), 436 {Xs2, St2} = visit_clauses(Xs, Ts, L, St1), 437 {join(Xs1, Xs2), St2}; 438visit_clauses(_, [], _L, St) -> 439 {none, St}. 440 441bind_defs([{V, F} | Ds], Vars) -> 442 bind_defs(Ds, dict:store(get_label(V), singleton(get_label(F)), 443 Vars)); 444bind_defs([], Vars) -> 445 Vars. 446 447bind_pats(Ps, none, Vars) -> 448 bind_pats_single(Ps, empty(), Vars); 449bind_pats(Ps, Xs, Vars) -> 450 if length(Xs) =:= length(Ps) -> 451 bind_pats_list(Ps, Xs, Vars); 452 true -> 453 bind_pats_single(Ps, empty(), Vars) 454 end. 455 456bind_pats_list([P | Ps], [X | Xs], Vars) -> 457 bind_pats_list(Ps, Xs, bind_vars_single(pat_vars(P), X, Vars)); 458bind_pats_list([], [], Vars) -> 459 Vars. 460 461bind_pats_single([P | Ps], X, Vars) -> 462 bind_pats_single(Ps, X, bind_vars_single(pat_vars(P), X, Vars)); 463bind_pats_single([], _X, Vars) -> 464 Vars. 465 466bind_vars(Vs, none, Vars) -> 467 bind_vars_single(Vs, empty(), Vars); 468bind_vars(Vs, Xs, Vars) -> 469 if length(Vs) =:= length(Xs) -> 470 bind_vars_list(Vs, Xs, Vars); 471 true -> 472 bind_vars_single(Vs, empty(), Vars) 473 end. 474 475bind_vars_list([V | Vs], [X | Xs], Vars) -> 476 bind_vars_list(Vs, Xs, dict:store(get_label(V), X, Vars)); 477bind_vars_list([], [], Vars) -> 478 Vars. 479 480bind_vars_single([V | Vs], X, Vars) -> 481 bind_vars_single(Vs, X, dict:store(get_label(V), X, Vars)); 482bind_vars_single([], _X, Vars) -> 483 Vars. 484 485%% This handles a call site - adding dependencies and updating parameter 486%% variables with respect to the actual parameters. The 'external' 487%% function is handled specially, since it can get an arbitrary number 488%% of arguments, which must be unified into a single argument. 489 490call_site(Ls, L, Xs, St) -> 491%%% io:fwrite("call site: ~w -> ~w (~w).\n", [L, Ls, Xs]), 492 {D, W, V} = call_site(Ls, L, Xs, St#state.dep, St#state.work, 493 St#state.vars, St#state.funs), 494 St#state{dep = D, work = W, vars = V}. 495 496call_site([external | Ls], T, Xs, D, W, V, Fs) -> 497 D1 = add_dep(external, T, D), 498 X = join_single_list(Xs), 499 case bind_arg(escape, X, V) of 500 {V1, true} -> 501%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n", 502%%% [dict:fetch(escape, V1), dict:fetch(escape, V), 503%%% X]), 504 {W1, V2} = update_esc(set__to_list(X), W, V1, Fs), 505 call_site(Ls, T, Xs, D1, add_work([external], W1), V2, Fs); 506 {V1, false} -> 507 call_site(Ls, T, Xs, D1, W, V1, Fs) 508 end; 509call_site([L | Ls], T, Xs, D, W, V, Fs) -> 510 D1 = add_dep(L, T, D), 511 Vs = fun_vars(dict:fetch(L, Fs)), 512 case bind_args(Vs, Xs, V) of 513 {V1, true} -> 514 call_site(Ls, T, Xs, D1, add_work([L], W), V1, Fs); 515 {V1, false} -> 516 call_site(Ls, T, Xs, D1, W, V1, Fs) 517 end; 518call_site([], _, _, D, W, V, _) -> 519 {D, W, V}. 520 521%% Note that `visit' makes sure all lambdas are visited at least once. 522%% For every called function, we add a dependency from the *called* 523%% function to the function containing the call site. 524 525add_dep(Source, Target, Deps) -> 526 case dict:find(Source, Deps) of 527 {ok, X} -> 528 case set__is_member(Target, X) of 529 true -> 530 Deps; 531 false -> 532%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]), 533 dict:store(Source, set__add(Target, X), Deps) 534 end; 535 error -> 536%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]), 537 dict:store(Source, set__singleton(Target), Deps) 538 end. 539 540%% If the arity does not match the call, nothing is done here. 541 542bind_args(Vs, Xs, Vars) -> 543 if length(Vs) =:= length(Xs) -> 544 bind_args(Vs, Xs, Vars, false); 545 true -> 546 {Vars, false} 547 end. 548 549bind_args([V | Vs], [X | Xs], Vars, Ch) -> 550 L = get_label(V), 551 {Vars1, Ch1} = bind_arg(L, X, Vars, Ch), 552 bind_args(Vs, Xs, Vars1, Ch1); 553bind_args([], [], Vars, Ch) -> 554 {Vars, Ch}. 555 556bind_args_single(Vs, X, Vars) -> 557 bind_args_single(Vs, X, Vars, false). 558 559bind_args_single([V | Vs], X, Vars, Ch) -> 560 L = get_label(V), 561 {Vars1, Ch1} = bind_arg(L, X, Vars, Ch), 562 bind_args_single(Vs, X, Vars1, Ch1); 563bind_args_single([], _, Vars, Ch) -> 564 {Vars, Ch}. 565 566bind_arg(L, X, Vars) -> 567 bind_arg(L, X, Vars, false). 568 569bind_arg(L, X, Vars, Ch) -> 570 X0 = dict:fetch(L, Vars), 571 X1 = join_single(X, X0), 572 case equal_single(X0, X1) of 573 true -> 574 {Vars, Ch}; 575 false -> 576%%% io:fwrite("arg (~w) changed: ~w <- ~w + ~w.\n", 577%%% [L, X1, X0, X]), 578 {dict:store(L, X1, Vars), true} 579 end. 580 581%% This handles escapes from things like primops and remote calls. 582 583%% escape(none, St) -> 584%% St; 585escape([X], St) -> 586 Vars = St#state.vars, 587 X0 = dict:fetch(escape, Vars), 588 X1 = join_single(X, X0), 589 case equal_single(X0, X1) of 590 true -> 591 St; 592 false -> 593%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n", [X1, X0, X]), 594%%% io:fwrite("updating escaping funs: ~w.\n", [set__to_list(X)]), 595 Vars1 = dict:store(escape, X1, Vars), 596 {W, Vars2} = update_esc(set__to_list(set__subtract(X, X0)), 597 St#state.work, Vars1, 598 St#state.funs), 599 St#state{work = add_work([external], W), vars = Vars2} 600 end. 601 602%% For all escaping lambdas, since they might be called from outside the 603%% program, all their arguments may be an external lambda. (Note that we 604%% only have to include the `external' label once per escaping lambda.) 605%% If the escape set has changed, we need to revisit the `external' fun. 606 607update_esc(Ls, W, V, Fs) -> 608 update_esc(Ls, singleton(external), W, V, Fs). 609 610%% The external lambda is skipped here - the Escape variable is known to 611%% contain `external' from the start. 612 613update_esc([external | Ls], X, W, V, Fs) -> 614 update_esc(Ls, X, W, V, Fs); 615update_esc([L | Ls], X, W, V, Fs) -> 616 Vs = fun_vars(dict:fetch(L, Fs)), 617 case bind_args_single(Vs, X, V) of 618 {V1, true} -> 619 update_esc(Ls, X, add_work([L], W), V1, Fs); 620 {V1, false} -> 621 update_esc(Ls, X, W, V1, Fs) 622 end; 623update_esc([], _, W, V, _) -> 624 {W, V}. 625 626set_parent([L | Ls], L1, D) -> 627 set_parent(Ls, L1, dict:store(L, L1, D)); 628set_parent([], _L1, D) -> 629 D. 630 631%% Handle primop calls: (At present, we assume that all unknown primops 632%% yield exactly one value. This might have to be changed.) 633 634primop_call(F, A, Xs, St0) -> 635 case is_pure_op(F, A) of 636 %% XXX: this case is currently not possible -- commented out. 637 %% true -> 638 %% case is_literal_op(F, A) of 639 %% true -> {[empty()], St0}; 640 %% false -> {[join_single_list(Xs)], St0} 641 %% end; 642 false -> 643 St1 = case is_escape_op(F, A) of 644 true -> escape([join_single_list(Xs)], St0); 645 false -> St0 646 end, 647 case is_literal_op(F, A) of 648 true -> {none, St1}; 649 false -> {[singleton(external)], St1} 650 end 651 end. 652 653%% Handle remote-calls: (At present, we assume that all unknown calls 654%% yield exactly one value. This might have to be changed.) 655 656remote_call(M, F, Xs, St) -> 657 case is_c_atom(M) andalso is_c_atom(F) of 658 true -> 659 remote_call_1(atom_val(M), atom_val(F), length(Xs), Xs, St); 660 false -> 661 %% Unknown function 662 {[singleton(external)], escape([join_single_list(Xs)], St)} 663 end. 664 665remote_call_1(M, F, A, Xs, St0) -> 666 case is_pure_op(M, F, A) of 667 true -> 668 case is_literal_op(M, F, A) of 669 true -> {[empty()], St0}; 670 false -> {[join_single_list(Xs)], St0} 671 end; 672 false -> 673 St1 = case is_escape_op(M, F, A) of 674 true -> escape([join_single_list(Xs)], St0); 675 false -> St0 676 end, 677 case is_literal_op(M, F, A) of 678 true -> {[empty()], St1}; 679 false -> {[singleton(external)], St1} 680 end 681 end. 682 683%% Domain: none | [Vs], where Vs = set(integer()). 684 685join(none, Xs2) -> Xs2; 686join(Xs1, none) -> Xs1; 687join(Xs1, Xs2) -> 688 if length(Xs1) =:= length(Xs2) -> 689 join_1(Xs1, Xs2); 690 true -> 691 none 692 end. 693 694join_1([X1 | Xs1], [X2 | Xs2]) -> 695 [join_single(X1, X2) | join_1(Xs1, Xs2)]; 696join_1([], []) -> 697 []. 698 699empty() -> set__new(). 700 701singleton(X) -> set__singleton(X). 702 703from_label_list(X) -> set__from_list(X). 704 705join_single(none, Y) -> Y; 706join_single(X, none) -> X; 707join_single(X, Y) -> set__union(X, Y). 708 709join_list([Xs | Xss]) -> 710 join(Xs, join_list(Xss)); 711join_list([]) -> 712 none. 713 714join_single_list([X | Xs]) -> 715 join_single(X, join_single_list(Xs)); 716join_single_list([]) -> 717 empty(). 718 719equal(none, none) -> true; 720equal(none, _) -> false; 721equal(_, none) -> false; 722equal(X1, X2) -> equal_1(X1, X2). 723 724equal_1([X1 | Xs1], [X2 | Xs2]) -> 725 equal_single(X1, X2) andalso equal_1(Xs1, Xs2); 726equal_1([], []) -> true; 727equal_1(_, _) -> false. 728 729equal_single(X, Y) -> set__equal(X, Y). 730 731%% Set abstraction for label sets in the domain. 732 733set__new() -> []. 734 735set__singleton(X) -> [X]. 736 737set__to_list(S) -> S. 738 739set__from_list(S) -> ordsets:from_list(S). 740 741set__union(X, Y) -> ordsets:union(X, Y). 742 743set__add(X, S) -> ordsets:add_element(X, S). 744 745set__is_member(X, S) -> ordsets:is_element(X, S). 746 747set__subtract(X, Y) -> ordsets:subtract(X, Y). 748 749set__equal(X, Y) -> X =:= Y. 750 751%% A simple but efficient functional queue. 752 753queue__new() -> {[], []}. 754 755queue__put(X, {In, Out}) -> {[X | In], Out}. 756 757queue__get({In, [X | Out]}) -> {ok, X, {In, Out}}; 758queue__get({[], _}) -> empty; 759queue__get({In, _}) -> 760 [X | In1] = lists:reverse(In), 761 {ok, X, {[], In1}}. 762 763%% The work list - a queue without repeated elements. 764 765init_work() -> 766 {queue__new(), sets:new()}. 767 768add_work(Ls, {Q, Set}) -> 769 add_work(Ls, Q, Set). 770 771%% Note that the elements are enqueued in order. 772 773add_work([L | Ls], Q, Set) -> 774 case sets:is_element(L, Set) of 775 true -> 776 add_work(Ls, Q, Set); 777 false -> 778 add_work(Ls, queue__put(L, Q), sets:add_element(L, Set)) 779 end; 780add_work([], Q, Set) -> 781 {Q, Set}. 782 783take_work({Queue0, Set0}) -> 784 case queue__get(Queue0) of 785 {ok, L, Queue1} -> 786 Set1 = sets:del_element(L, Set0), 787 {ok, L, {Queue1, Set1}}; 788 empty -> 789 none 790 end. 791 792%% Escape operators may let their arguments escape. Unless we know 793%% otherwise, and the function is not pure, we assume this is the case. 794%% Error-raising functions (fault/match_fail) are not considered as 795%% escapes (but throw/exit are). Zero-argument functions need not be 796%% listed. 797 798-spec is_escape_op(atom(), arity()) -> boolean(). 799 800is_escape_op(match_fail, 1) -> false; 801is_escape_op(recv_wait_timeout, 1) -> false; 802is_escape_op(F, A) when is_atom(F), is_integer(A) -> true. 803 804-spec is_escape_op(atom(), atom(), arity()) -> boolean(). 805 806is_escape_op(erlang, error, 1) -> false; 807is_escape_op(erlang, error, 2) -> false; 808is_escape_op(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> true. 809 810%% "Literal" operators will never return functional values even when 811%% found in their arguments. Unless we know otherwise, we assume this is 812%% not the case. (More functions can be added to this list, if needed 813%% for better precision. Note that the result of `term_to_binary' still 814%% contains an encoding of the closure.) 815 816-spec is_literal_op(atom(), arity()) -> boolean(). 817 818is_literal_op(recv_wait_timeout, 1) -> true; 819is_literal_op(match_fail, 1) -> true; 820is_literal_op(F, A) when is_atom(F), is_integer(A) -> false. 821 822-spec is_literal_op(atom(), atom(), arity()) -> boolean(). 823 824is_literal_op(erlang, '+', 2) -> true; 825is_literal_op(erlang, '-', 2) -> true; 826is_literal_op(erlang, '*', 2) -> true; 827is_literal_op(erlang, '/', 2) -> true; 828is_literal_op(erlang, '=:=', 2) -> true; 829is_literal_op(erlang, '==', 2) -> true; 830is_literal_op(erlang, '=/=', 2) -> true; 831is_literal_op(erlang, '/=', 2) -> true; 832is_literal_op(erlang, '<', 2) -> true; 833is_literal_op(erlang, '=<', 2) -> true; 834is_literal_op(erlang, '>', 2) -> true; 835is_literal_op(erlang, '>=', 2) -> true; 836is_literal_op(erlang, 'and', 2) -> true; 837is_literal_op(erlang, 'or', 2) -> true; 838is_literal_op(erlang, 'not', 1) -> true; 839is_literal_op(erlang, length, 1) -> true; 840is_literal_op(erlang, size, 1) -> true; 841is_literal_op(erlang, fun_info, 1) -> true; 842is_literal_op(erlang, fun_info, 2) -> true; 843is_literal_op(erlang, fun_to_list, 1) -> true; 844is_literal_op(erlang, throw, 1) -> true; 845is_literal_op(erlang, exit, 1) -> true; 846is_literal_op(erlang, error, 1) -> true; 847is_literal_op(erlang, error, 2) -> true; 848is_literal_op(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> false. 849 850%% Pure functions neither affect the state, nor depend on it. 851 852is_pure_op(F, A) when is_atom(F), is_integer(A) -> false. 853 854is_pure_op(M, F, A) -> erl_bifs:is_pure(M, F, A). 855 856%% ===================================================================== 857