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 Utility functions for Core Erlang abstract syntax trees. 16%% 17%% <p>Syntax trees are defined in the module <a 18%% href=""><code>cerl</code></a>.</p> 19%% 20%% @type cerl() = cerl:cerl() 21 22-module(cerl_lib). 23 24-define(NO_UNUSED, true). 25 26-export([is_safe_expr/2, reduce_expr/1, is_simple_clause/1, 27 is_bool_switch/1, bool_switch_cases/1]). 28-ifndef(NO_UNUSED). 29-export([is_safe_expr/1, is_pure_expr/1, is_pure_expr/2, 30 make_bool_switch/3]). 31-endif. 32 33 34%% Test if a clause has a single pattern and an always-true guard. 35 36-spec is_simple_clause(cerl:c_clause()) -> boolean(). 37 38is_simple_clause(C) -> 39 case cerl:clause_pats(C) of 40 [_P] -> 41 G = cerl:clause_guard(C), 42 case cerl_clauses:eval_guard(G) of 43 {value, true} -> true; 44 _ -> false 45 end; 46 _ -> false 47 end. 48 49%% Creating an if-then-else construct that can be recognized as such. 50%% `Test' *must* be guaranteed to return a boolean. 51 52-ifndef(NO_UNUSED). 53make_bool_switch(Test, True, False) -> 54 Cs = [cerl:c_clause([cerl:c_atom(true)], True), 55 cerl:c_clause([cerl:c_atom(false)], False)], 56 cerl:c_case(Test, Cs). 57-endif. 58 59%% A boolean switch cannot have a catch-all; only true/false branches. 60 61-spec is_bool_switch([cerl:c_clause()]) -> boolean(). 62 63is_bool_switch([C1, C2]) -> 64 case is_simple_clause(C1) andalso is_simple_clause(C2) of 65 true -> 66 [P1] = cerl:clause_pats(C1), 67 [P2] = cerl:clause_pats(C2), 68 case cerl:is_c_atom(P1) andalso cerl:is_c_atom(P2) of 69 true -> 70 A1 = cerl:concrete(P1), 71 A2 = cerl:concrete(P2), 72 is_boolean(A1) andalso is_boolean(A2) 73 andalso A1 =/= A2; 74 false -> 75 false 76 end; 77 false -> 78 false 79 end; 80is_bool_switch(_) -> 81 false. 82 83%% Returns the true-body and the false-body for boolean switch clauses. 84 85-spec bool_switch_cases([cerl:c_clause()]) -> {cerl:cerl(), cerl:cerl()}. 86 87bool_switch_cases([C1, C2]) -> 88 B1 = cerl:clause_body(C1), 89 B2 = cerl:clause_body(C2), 90 [P1] = cerl:clause_pats(C1), 91 case cerl:concrete(P1) of 92 true -> 93 {B1, B2}; 94 false -> 95 {B2, B1} 96 end. 97 98%% 99%% The type of the check functions like the default check below - XXX: refine 100%% 101-type check_fun() :: fun((_, _) -> boolean()). 102 103%% The default function property check always returns `false': 104 105default_check(_Property, _Function) -> false. 106 107 108%% @spec is_safe_expr(Expr::cerl()) -> boolean() 109%% 110%% @doc Returns `true' if `Expr' represents a "safe" Core Erlang 111%% expression, otherwise `false'. An expression is safe if it always 112%% completes normally and does not modify the state (although the return 113%% value may depend on the state). 114%% 115%% Expressions of type `apply', `case', `receive' and `binary' are 116%% always considered unsafe by this function. 117 118%% TODO: update cerl_inline to use these functions instead. 119 120-ifndef(NO_UNUSED). 121is_safe_expr(E) -> 122 Check = fun default_check/2, 123 is_safe_expr(E, Check). 124-endif. 125%% @clear 126 127-spec is_safe_expr(cerl:cerl(), check_fun()) -> boolean(). 128 129is_safe_expr(E, Check) -> 130 case cerl:type(E) of 131 literal -> 132 true; 133 var -> 134 true; 135 'fun' -> 136 true; 137 values -> 138 is_safe_expr_list(cerl:values_es(E), Check); 139 tuple -> 140 is_safe_expr_list(cerl:tuple_es(E), Check); 141 cons -> 142 case is_safe_expr(cerl:cons_hd(E), Check) of 143 true -> 144 is_safe_expr(cerl:cons_tl(E), Check); 145 false -> 146 false 147 end; 148 'let' -> 149 case is_safe_expr(cerl:let_arg(E), Check) of 150 true -> 151 is_safe_expr(cerl:let_body(E), Check); 152 false -> 153 false 154 end; 155 letrec -> 156 is_safe_expr(cerl:letrec_body(E), Check); 157 seq -> 158 case is_safe_expr(cerl:seq_arg(E), Check) of 159 true -> 160 is_safe_expr(cerl:seq_body(E), Check); 161 false -> 162 false 163 end; 164 'catch' -> 165 is_safe_expr(cerl:catch_body(E), Check); 166 'try' -> 167 %% If the guarded expression is safe, the try-handler will 168 %% never be evaluated, so we need only check the body. If 169 %% the guarded expression is pure, but could fail, we also 170 %% have to check the handler. 171 case is_safe_expr(cerl:try_arg(E), Check) of 172 true -> 173 is_safe_expr(cerl:try_body(E), Check); 174 false -> 175 case is_pure_expr(cerl:try_arg(E), Check) of 176 true -> 177 case is_safe_expr(cerl:try_body(E), Check) of 178 true -> 179 is_safe_expr(cerl:try_handler(E), Check); 180 false -> 181 false 182 end; 183 false -> 184 false 185 end 186 end; 187 primop -> 188 Name = cerl:atom_val(cerl:primop_name(E)), 189 As = cerl:primop_args(E), 190 case Check(safe, {Name, length(As)}) of 191 true -> 192 is_safe_expr_list(As, Check); 193 false -> 194 false 195 end; 196 call -> 197 Module = cerl:call_module(E), 198 Name = cerl:call_name(E), 199 case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of 200 true -> 201 M = cerl:atom_val(Module), 202 F = cerl:atom_val(Name), 203 As = cerl:call_args(E), 204 case Check(safe, {M, F, length(As)}) of 205 true -> 206 is_safe_expr_list(As, Check); 207 false -> 208 false 209 end; 210 false -> 211 false % Call to unknown function 212 end; 213 _ -> 214 false 215 end. 216 217is_safe_expr_list([E | Es], Check) -> 218 case is_safe_expr(E, Check) of 219 true -> 220 is_safe_expr_list(Es, Check); 221 false -> 222 false 223 end; 224is_safe_expr_list([], _Check) -> 225 true. 226 227 228%% @spec (Expr::cerl()) -> bool() 229%% 230%% @doc Returns `true' if `Expr' represents a "pure" Core Erlang 231%% expression, otherwise `false'. An expression is pure if it does not 232%% affect the state, nor depend on the state, although its evaluation is 233%% not guaranteed to complete normally for all input. 234%% 235%% Expressions of type `apply', `case', `receive' and `binary' are 236%% always considered impure by this function. 237 238-ifndef(NO_UNUSED). 239is_pure_expr(E) -> 240 Check = fun default_check/2, 241 is_pure_expr(E, Check). 242-endif. 243%% @clear 244 245is_pure_expr(E, Check) -> 246 case cerl:type(E) of 247 literal -> 248 true; 249 var -> 250 true; 251 'fun' -> 252 true; 253 values -> 254 is_pure_expr_list(cerl:values_es(E), Check); 255 tuple -> 256 is_pure_expr_list(cerl:tuple_es(E), Check); 257 cons -> 258 case is_pure_expr(cerl:cons_hd(E), Check) of 259 true -> 260 is_pure_expr(cerl:cons_tl(E), Check); 261 false -> 262 false 263 end; 264 'let' -> 265 case is_pure_expr(cerl:let_arg(E), Check) of 266 true -> 267 is_pure_expr(cerl:let_body(E), Check); 268 false -> 269 false 270 end; 271 letrec -> 272 is_pure_expr(cerl:letrec_body(E), Check); 273 seq -> 274 case is_pure_expr(cerl:seq_arg(E), Check) of 275 true -> 276 is_pure_expr(cerl:seq_body(E), Check); 277 false -> 278 false 279 end; 280 'catch' -> 281 is_pure_expr(cerl:catch_body(E), Check); 282 'try' -> 283 case is_pure_expr(cerl:try_arg(E), Check) of 284 true -> 285 case is_pure_expr(cerl:try_body(E), Check) of 286 true -> 287 is_pure_expr(cerl:try_handler(E), Check); 288 false -> 289 false 290 end; 291 false -> 292 false 293 end; 294 primop -> 295 Name = cerl:atom_val(cerl:primop_name(E)), 296 As = cerl:primop_args(E), 297 case Check(pure, {Name, length(As)}) of 298 true -> 299 is_pure_expr_list(As, Check); 300 false -> 301 false 302 end; 303 call -> 304 Module = cerl:call_module(E), 305 Name = cerl:call_name(E), 306 case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of 307 true -> 308 M = cerl:atom_val(Module), 309 F = cerl:atom_val(Name), 310 As = cerl:call_args(E), 311 case Check(pure, {M, F, length(As)}) of 312 true -> 313 is_pure_expr_list(As, Check); 314 false -> 315 false 316 end; 317 false -> 318 false % Call to unknown function 319 end; 320 _ -> 321 false 322 end. 323 324is_pure_expr_list([E | Es], Check) -> 325 case is_pure_expr(E, Check) of 326 true -> 327 is_pure_expr_list(Es, Check); 328 false -> 329 false 330 end; 331is_pure_expr_list([], _Check) -> 332 true. 333 334 335%% Peephole optimizations 336%% 337%% This is only intended to be a light-weight cleanup optimizer, 338%% removing small things that may e.g. have been generated by other 339%% optimization passes or in the translation from higher-level code. 340%% It is not recursive in general - it only descends until it can do no 341%% more work in the current context. 342%% 343%% To expose hidden cases of final expressions (enabling last call 344%% optimization), we try to remove all trivial let-bindings (`let X = Y 345%% in X', `let X = Y in Y', `let X = Y in let ... in ...', `let X = let 346%% ... in ... in ...', etc.). We do not, however, try to recognize any 347%% other similar cases, even for simple `case'-expressions like `case E 348%% of X -> X end', or simultaneous multiple-value bindings. 349 350-spec reduce_expr(cerl:cerl()) -> cerl:cerl(). 351 352reduce_expr(E) -> 353 Check = fun default_check/2, 354 reduce_expr(E, Check). 355 356-spec reduce_expr(cerl:cerl(), check_fun()) -> cerl:cerl(). 357 358reduce_expr(E, Check) -> 359 case cerl:type(E) of 360 values -> 361 case cerl:values_es(E) of 362 [E1] -> 363 %% Not really an "optimization" in itself, but 364 %% enables other rewritings by removing the wrapper. 365 reduce_expr(E1, Check); 366 _ -> 367 E 368 end; 369 'seq' -> 370 A = reduce_expr(cerl:seq_arg(E), Check), 371 B = reduce_expr(cerl:seq_body(E), Check), 372 %% `do <E1> <E2>' is equivalent to `<E2>' if `<E1>' is 373 %% "safe" (cannot effect the behaviour in any way). 374 case is_safe_expr(A, Check) of 375 true -> 376 B; 377 false -> 378 case cerl:is_c_seq(B) of 379 true -> 380 %% Rewrite `do <E1> do <E2> <E3>' to `do do 381 %% <E1> <E2> <E3>' so that the "body" of the 382 %% outermost seq-operator is the expression 383 %% which produces the final result (i.e., 384 %% E3). This can make other optimizations 385 %% easier; see `let'. 386 B1 = cerl:seq_arg(B), 387 B2 = cerl:seq_body(B), 388 cerl:c_seq(cerl:c_seq(A, B1), B2); 389 false -> 390 cerl:c_seq(A, B) 391 end 392 end; 393 'let' -> 394 A = reduce_expr(cerl:let_arg(E), Check), 395 case cerl:is_c_seq(A) of 396 true -> 397 %% `let X = do <E1> <E2> in Y' is equivalent to `do 398 %% <E1> let X = <E2> in Y'. Note that `<E2>' cannot 399 %% be a seq-operator, due to the `seq' optimization. 400 A1 = cerl:seq_arg(A), 401 A2 = cerl:seq_body(A), 402 E1 = cerl:update_c_let(E, cerl:let_vars(E), 403 A2, cerl:let_body(E)), 404 cerl:c_seq(A1, reduce_expr(E1, Check)); 405 false -> 406 B = reduce_expr(cerl:let_body(E), Check), 407 Vs = cerl:let_vars(E), 408 %% We give up if the body does not reduce to a 409 %% single variable. This is not a generic copy 410 %% propagation. 411 case cerl:type(B) of 412 var when length(Vs) =:= 1 -> 413 %% We have `let <V1> = <E> in <V2>': 414 [V] = Vs, 415 N1 = cerl:var_name(V), 416 N2 = cerl:var_name(B), 417 if N1 =:= N2 -> 418 %% `let X = <E> in X' equals `<E>' 419 A; 420 true -> 421 %% `let X = <E> in Y' when X and Y 422 %% are different variables is 423 %% equivalent to `do <E> Y'. 424 reduce_expr(cerl:c_seq(A, B), Check) 425 end; 426 literal -> 427 %% `let X = <E> in T' when T is a literal 428 %% term is equivalent to `do <E> T'. 429 reduce_expr(cerl:c_seq(A, B), Check); 430 _ -> 431 cerl:update_c_let(E, Vs, A, B) 432 end 433 end; 434 'try' -> 435 %% Get rid of unnecessary try-expressions. 436 A = reduce_expr(cerl:try_arg(E), Check), 437 B = reduce_expr(cerl:try_body(E), Check), 438 case is_safe_expr(A, Check) of 439 true -> 440 B; 441 false -> 442 cerl:update_c_try(E, A, cerl:try_vars(E), B, 443 cerl:try_evars(E), 444 cerl:try_handler(E)) 445 end; 446 'catch' -> 447 %% Just a simpler form of try-expressions. 448 B = reduce_expr(cerl:catch_body(E), Check), 449 case is_safe_expr(B, Check) of 450 true -> 451 B; 452 false -> 453 cerl:update_c_catch(E, B) 454 end; 455 _ -> 456 E 457 end. 458