← Back to branch summary

~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

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