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