~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to lib/syntax_tools/src/erl_syntax_lib.erl

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%% =====================================================================
 
2
%% Support library for abstract Erlang syntax trees.
 
3
%%
 
4
%% Copyright (C) 1997-2002 Richard Carlsson
 
5
%%
 
6
%% This library is free software; you can redistribute it and/or modify
 
7
%% it under the terms of the GNU Lesser General Public License as
 
8
%% published by the Free Software Foundation; either version 2 of the
 
9
%% License, or (at your option) any later version.
 
10
%%
 
11
%% This library is distributed in the hope that it will be useful, but
 
12
%% WITHOUT ANY WARRANTY; without even the implied warranty of
 
13
%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 
14
%% Lesser General Public License for more details.
 
15
%%
 
16
%% You should have received a copy of the GNU Lesser General Public
 
17
%% License along with this library; if not, write to the Free Software
 
18
%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
 
19
%% USA
 
20
%%
 
21
%% Author contact: richardc@csd.uu.se
 
22
%%
 
23
%% $Id$
 
24
%%
 
25
%% =====================================================================
 
26
%%
 
27
%% @doc Support library for abstract Erlang syntax trees.
 
28
%%
 
29
%% <p> This module contains utility functions for working with the
 
30
%% abstract data type defined in the module <a
 
31
%% href="erl_syntax.html"><code>erl_syntax</code></a>.</p>
 
32
%%
 
33
%% @type syntaxTree() = erl_syntax:syntaxTree(). An abstract syntax
 
34
%% tree. See the <code>erl_syntax</code> module for details.
 
35
 
 
36
-module(erl_syntax_lib).
 
37
 
 
38
-export([analyze_application/1, analyze_attribute/1,
 
39
         analyze_export_attribute/1, analyze_file_attribute/1,
 
40
         analyze_form/1, analyze_forms/1, analyze_function/1,
 
41
         analyze_function_name/1, analyze_implicit_fun/1,
 
42
         analyze_import_attribute/1, analyze_module_attribute/1,
 
43
         analyze_record_attribute/1, analyze_record_expr/1,
 
44
         analyze_record_field/1, analyze_rule/1,
 
45
         analyze_wild_attribute/1, annotate_bindings/1,
 
46
         annotate_bindings/2, fold/3, fold_subtrees/3, foldl_listlist/3,
 
47
         function_name_expansions/1, is_fail_expr/1, limit/2, limit/3,
 
48
         map/2, map_subtrees/2, mapfold/3, mapfold_subtrees/3,
 
49
         mapfoldl_listlist/3, new_variable_name/1, new_variable_name/2,
 
50
         new_variable_names/2, new_variable_names/3, strip_comments/1,
 
51
         to_comment/1, to_comment/2, to_comment/3, variables/1]).
 
52
 
 
53
 
 
54
%% =====================================================================
 
55
%% @spec map(Function, Tree::syntaxTree()) -> syntaxTree()
 
56
%%
 
57
%%          Function = (syntaxTree()) -> syntaxTree()
 
58
%% 
 
59
%% @doc Applies a function to each node of a syntax tree. The result of
 
60
%% each application replaces the corresponding original node. The order
 
61
%% of traversal is bottom-up.
 
62
%%
 
63
%% @see map_subtrees/2
 
64
 
 
65
map(F, Tree) ->
 
66
    case erl_syntax:subtrees(Tree) of
 
67
        [] ->
 
68
            F(Tree);
 
69
        Gs ->
 
70
            Tree1 = erl_syntax:make_tree(erl_syntax:type(Tree),
 
71
                                         [[map(F, T) || T <- G]
 
72
                                          || G <- Gs]),
 
73
            F(erl_syntax:copy_attrs(Tree, Tree1))
 
74
    end.
 
75
 
 
76
 
 
77
%% =====================================================================
 
78
%% @spec map_subtrees(Function, syntaxTree()) -> syntaxTree()
 
79
%%
 
80
%%          Function = (Tree) -> Tree1
 
81
%%         
 
82
%% @doc Applies a function to each immediate subtree of a syntax tree.
 
83
%% The result of each application replaces the corresponding original
 
84
%% node.
 
85
%%
 
86
%% @see map/2
 
87
 
 
88
map_subtrees(F, Tree) ->
 
89
    case erl_syntax:subtrees(Tree) of
 
90
        [] ->
 
91
            Tree;
 
92
        Gs ->
 
93
            Tree1 = erl_syntax:make_tree(erl_syntax:type(Tree),
 
94
                                         [[F(T) || T <- G] || G <- Gs]),
 
95
            erl_syntax:copy_attrs(Tree, Tree1)
 
96
    end.
 
97
 
 
98
 
 
99
%% =====================================================================
 
100
%% @spec fold(Function, Start::term(), Tree::syntaxTree()) -> term()
 
101
%%
 
102
%%          Function = (syntaxTree(), term()) -> term()
 
103
%%
 
104
%% @doc Folds a function over all nodes of a syntax tree. The result is
 
105
%% the value of <code>Function(X1, Function(X2, ... Function(Xn, Start)
 
106
%% ... ))</code>, where <code>[X1, X2, ..., Xn]</code> are the nodes of
 
107
%% <code>Tree</code> in a post-order traversal.
 
108
%%
 
109
%% @see fold_subtrees/3
 
110
%% @see foldl_listlist/3
 
111
 
 
112
fold(F, S, Tree) ->
 
113
    case erl_syntax:subtrees(Tree) of
 
114
        [] ->
 
115
            F(Tree, S);
 
116
        Gs ->
 
117
            F(Tree, fold_1(F, S, Gs))
 
118
    end.
 
119
 
 
120
fold_1(F, S, [L | Ls]) ->
 
121
    fold_1(F, fold_2(F, S, L), Ls);
 
122
fold_1(_, S, []) ->
 
123
    S.
 
124
 
 
125
fold_2(F, S, [T | Ts]) ->
 
126
    fold_2(F, fold(F, S, T), Ts);
 
127
fold_2(_, S, []) ->
 
128
    S.
 
129
 
 
130
 
 
131
%% =====================================================================
 
132
%% @spec fold_subtrees(Function, Start::term(), Tree::syntaxTree()) ->
 
133
%%           term()
 
134
%%
 
135
%%          Function = (syntaxTree(), term()) -> term()
 
136
%%
 
137
%% @doc Folds a function over the immediate subtrees of a syntax tree.
 
138
%% This is similar to <code>fold/3</code>, but only on the immediate
 
139
%% subtrees of <code>Tree</code>, in left-to-right order; it does not
 
140
%% include the root node of <code>Tree</code>.
 
141
%%
 
142
%% @see fold/3
 
143
 
 
144
fold_subtrees(F, S, Tree) ->
 
145
    foldl_listlist(F, S, erl_syntax:subtrees(Tree)).
 
146
 
 
147
 
 
148
%% =====================================================================
 
149
%% @spec foldl_listlist(Function, Start::term(), [[term()]]) -> term()
 
150
%%
 
151
%%          Function = (term(), term()) -> term()
 
152
%%
 
153
%% @doc Like <code>lists:foldl/3</code>, but over a list of lists.
 
154
%%
 
155
%% @see fold/3
 
156
%% @see lists:foldl/3
 
157
 
 
158
foldl_listlist(F, S, [L | Ls]) ->
 
159
    foldl_listlist(F, foldl(F, S, L), Ls);
 
160
foldl_listlist(_, S, []) ->
 
161
    S.
 
162
 
 
163
foldl(F, S, [T | Ts]) ->
 
164
    foldl(F, F(T, S), Ts);
 
165
foldl(_, S, []) ->
 
166
    S.
 
167
 
 
168
 
 
169
%% =====================================================================
 
170
%% @spec mapfold(Function, Start::term(), Tree::syntaxTree()) ->
 
171
%%           {syntaxTree(), term()}
 
172
%%
 
173
%%          Function = (syntaxTree(), term()) -> {syntaxTree(), term()}
 
174
%%
 
175
%% @doc Combines map and fold in a single operation. This is similar to
 
176
%% <code>map/2</code>, but also propagates an extra value from each
 
177
%% application of the <code>Function</code> to the next, while doing a
 
178
%% post-order traversal of the tree like <code>fold/3</code>. The value
 
179
%% <code>Start</code> is passed to the first function application, and
 
180
%% the final result is the result of the last application.
 
181
%%
 
182
%% @see map/2
 
183
%% @see fold/3
 
184
 
 
185
mapfold(F, S, Tree) ->
 
186
    case erl_syntax:subtrees(Tree) of
 
187
        [] ->
 
188
            F(Tree, S);
 
189
        Gs ->
 
190
            {Gs1, S1} = mapfold_1(F, S, Gs),
 
191
            Tree1 = erl_syntax:make_tree(erl_syntax:type(Tree), Gs1),
 
192
            F(erl_syntax:copy_attrs(Tree, Tree1), S1)
 
193
    end.
 
194
 
 
195
mapfold_1(F, S, [L | Ls]) ->
 
196
    {L1, S1} = mapfold_2(F, S, L),
 
197
    {Ls1, S2} = mapfold_1(F, S1, Ls),
 
198
    {[L1 | Ls1], S2};
 
199
mapfold_1(_, S, []) ->
 
200
    {[], S}.
 
201
 
 
202
mapfold_2(F, S, [T | Ts]) ->
 
203
    {T1, S1} = mapfold(F, S, T),
 
204
    {Ts1, S2} = mapfold_2(F, S1, Ts),
 
205
    {[T1 | Ts1], S2};
 
206
mapfold_2(_, S, []) ->
 
207
    {[], S}.
 
208
 
 
209
 
 
210
%% =====================================================================
 
211
%% @spec mapfold_subtrees(Function, Start::term(),
 
212
%%                        Tree::syntaxTree()) -> {syntaxTree(), term()}
 
213
%%
 
214
%%          Function = (syntaxTree(), term()) -> {syntaxTree(), term()}
 
215
%%
 
216
%% @doc Does a mapfold operation over the immediate subtrees of a syntax
 
217
%% tree. This is similar to <code>mapfold/3</code>, but only on the
 
218
%% immediate subtrees of <code>Tree</code>, in left-to-right order; it
 
219
%% does not include the root node of <code>Tree</code>.
 
220
%%
 
221
%% @see mapfold/3
 
222
 
 
223
mapfold_subtrees(F, S, Tree) ->
 
224
    case erl_syntax:subtrees(Tree) of
 
225
        [] ->
 
226
            {Tree, S};
 
227
        Gs ->
 
228
            {Gs1, S1} = mapfoldl_listlist(F, S, Gs),
 
229
            Tree1 = erl_syntax:make_tree(erl_syntax:type(Tree), Gs1),
 
230
            {erl_syntax:copy_attrs(Tree, Tree1), S1}
 
231
    end.
 
232
 
 
233
 
 
234
%% =====================================================================
 
235
%% @spec mapfoldl_listlist(Function, State, [[term()]]) ->
 
236
%%           {[[term()]], term()}
 
237
%%
 
238
%%          Function = (term(), term()) -> {term(), term()}
 
239
%%
 
240
%% @doc Like <code>lists:mapfoldl/3</code>, but over a list of lists.
 
241
%% The list of lists in the result has the same structure as the given
 
242
%% list of lists.
 
243
 
 
244
mapfoldl_listlist(F, S, [L | Ls]) ->
 
245
    {L1, S1} = mapfoldl(F, S, L),
 
246
    {Ls1, S2} = mapfoldl_listlist(F, S1, Ls),
 
247
    {[L1 | Ls1], S2};
 
248
mapfoldl_listlist(_, S, []) ->
 
249
    {[], S}.
 
250
 
 
251
mapfoldl(F, S, [L | Ls]) ->
 
252
    {L1, S1} = F(L, S),
 
253
    {Ls1, S2} = mapfoldl(F, S1, Ls),
 
254
    {[L1 | Ls1], S2};
 
255
mapfoldl(_, S, []) ->
 
256
    {[], S}.
 
257
 
 
258
 
 
259
%% =====================================================================
 
260
%% @spec variables(syntaxTree()) -> set(atom())
 
261
%%
 
262
%%        set(T) = sets:set(T)
 
263
%%
 
264
%% @doc Returns the names of variables occurring in a syntax tree, The
 
265
%% result is a set of variable names represented by atoms. Macro names
 
266
%% are not included.
 
267
%%
 
268
%% @see sets
 
269
 
 
270
variables(Tree) ->
 
271
    variables(Tree, sets:new()).
 
272
 
 
273
variables(T, S) ->
 
274
    case erl_syntax:type(T) of
 
275
        variable ->
 
276
            sets:add_element(erl_syntax:variable_name(T), S);
 
277
        macro ->
 
278
            %% macro names are ignored, even if represented by variables
 
279
            case erl_syntax:macro_arguments(T) of
 
280
                none -> S;
 
281
                As ->
 
282
                    variables_2(As, S)
 
283
            end;
 
284
        _ ->
 
285
            case erl_syntax:subtrees(T) of
 
286
                [] ->
 
287
                    S;
 
288
                Gs ->
 
289
                    variables_1(Gs, S)
 
290
            end
 
291
    end.
 
292
 
 
293
variables_1([L | Ls], S) ->
 
294
    variables_1(Ls, variables_2(L, S));
 
295
variables_1([], S) ->
 
296
    S.
 
297
 
 
298
variables_2([T | Ts], S) ->
 
299
    variables_2(Ts, variables(T, S));
 
300
variables_2([], S) ->
 
301
    S.
 
302
 
 
303
 
 
304
-define(MINIMUM_RANGE, 100).
 
305
-define(START_RANGE_FACTOR, 100).
 
306
-define(MAX_RETRIES, 3).    % retries before enlarging range
 
307
-define(ENLARGE_ENUM, 8).   % range enlargment enumerator
 
308
-define(ENLARGE_DENOM, 1).  % range enlargment denominator
 
309
 
 
310
default_variable_name(N) ->
 
311
    list_to_atom("V" ++ integer_to_list(N)).
 
312
 
 
313
%% =====================================================================
 
314
%% @spec new_variable_name(Used::set(atom())) -> atom()
 
315
%%
 
316
%% @doc Returns an atom which is not already in the set
 
317
%% <code>Used</code>. This is equivalent to
 
318
%% <code>new_variable_name(Function, Used)</code>, where
 
319
%% <code>Function</code> maps a given integer <code>N</code> to the atom
 
320
%% whose name consists of "<code>V</code>" followed by the numeral for
 
321
%% <code>N</code>.
 
322
%%
 
323
%% @see new_variable_name/2
 
324
 
 
325
new_variable_name(S) ->
 
326
    new_variable_name(fun default_variable_name/1, S).
 
327
 
 
328
%% =====================================================================
 
329
%% @spec new_variable_name(Function, Used::set(atom())) -> atom()
 
330
%%
 
331
%%          Function = (integer()) -> atom()
 
332
%%
 
333
%% @doc Returns a user-named atom which is not already in the set
 
334
%% <code>Used</code>. The atom is generated by applying the given
 
335
%% <code>Function</code> to a generated integer. Integers are generated
 
336
%% using an algorithm which tries to keep the names randomly distributed
 
337
%% within a reasonably small range relative to the number of elements in
 
338
%% the set.
 
339
%%
 
340
%% <p>This function uses the module <code>random</code> to generate new
 
341
%% keys. The seed it uses may be initialized by calling
 
342
%% <code>random:seed/0</code> or <code>random:seed/3</code> before this
 
343
%% function is first called.</p>
 
344
%%
 
345
%% @see new_variable_name/1
 
346
%% @see sets
 
347
%% @see random
 
348
 
 
349
new_variable_name(F, S) ->
 
350
    R = start_range(S),
 
351
    new_variable_name(R, F, S).
 
352
 
 
353
new_variable_name(R, F, S) ->
 
354
    new_variable_name(generate(R, R), R, 0, F, S).
 
355
 
 
356
new_variable_name(N, R, T, F, S) when T < ?MAX_RETRIES ->
 
357
    A = F(N),
 
358
    case sets:is_element(A, S) of
 
359
        true ->
 
360
            new_variable_name(generate(N, R), R, T + 1, F, S);
 
361
        false ->
 
362
            A
 
363
    end;
 
364
new_variable_name(N, R, _T, F, S) ->
 
365
    %% Too many retries - enlarge the range and start over.
 
366
    R1 = (R * ?ENLARGE_ENUM) div ?ENLARGE_DENOM,
 
367
    new_variable_name(generate(N, R1), R1, 0, F, S).
 
368
 
 
369
%% Note that we assume that it is very cheap to take the size of
 
370
%% the given set. This should be valid for the stdlib
 
371
%% implementation of `sets'.
 
372
 
 
373
start_range(S) ->
 
374
    max(sets:size(S) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE).
 
375
 
 
376
max(X, Y) when X > Y -> X;
 
377
max(_, Y) -> Y.
 
378
 
 
379
%% The previous number might or might not be used to compute the
 
380
%% next number to be tried. It is currently not used.
 
381
%%
 
382
%% It is important that this function does not generate values in
 
383
%% order, but (pseudo-)randomly distributed over the range.
 
384
 
 
385
generate(_Key, Range) ->
 
386
    random:uniform(Range).    % works well
 
387
 
 
388
 
 
389
%% =====================================================================
 
390
%% @spec new_variable_names(N::integer(), Used::set(atom())) -> [atom()]
 
391
%%
 
392
%% @doc Like <code>new_variable_name/1</code>, but generates a list of
 
393
%% <code>N</code> new names.
 
394
%% 
 
395
%% @see new_variable_name/1
 
396
 
 
397
new_variable_names(N, S) ->
 
398
    new_variable_names(N, fun default_variable_name/1, S).
 
399
 
 
400
%% =====================================================================
 
401
%% @spec new_variable_names(N::integer(), Function,
 
402
%%                          Used::set(atom())) -> [atom()]
 
403
%%
 
404
%%          Function = (integer()) -> atom()
 
405
%%
 
406
%% @doc Like <code>new_variable_name/2</code>, but generates a list of
 
407
%% <code>N</code> new names.
 
408
%% 
 
409
%% @see new_variable_name/2
 
410
 
 
411
new_variable_names(N, F, S) when integer(N) ->
 
412
    R = start_range(S),
 
413
    new_variable_names(N, [], R, F, S).
 
414
 
 
415
new_variable_names(N, Names, R, F, S) when N > 0 ->
 
416
    Name = new_variable_name(R, F, S),
 
417
    S1 = sets:add_element(Name, S),
 
418
    new_variable_names(N - 1, [Name | Names], R, F, S1);
 
419
new_variable_names(0, Names, _, _, _) ->
 
420
    Names.
 
421
 
 
422
 
 
423
%% =====================================================================
 
424
%% @spec annotate_bindings(Tree::syntaxTree(),
 
425
%%                         Bindings::ordset(atom())) -> syntaxTree()
 
426
%%
 
427
%%          ordset(T) = ordsets:ordset(T)
 
428
%%
 
429
%% @doc Adds or updates annotations on nodes in a syntax tree.
 
430
%% <code>Bindings</code> specifies the set of bound variables in the
 
431
%% environment of the top level node. The following annotations are
 
432
%% affected:
 
433
%% <ul>
 
434
%%     <li><code>{env, Vars}</code>, representing the input environment
 
435
%%     of the subtree.</li>
 
436
%%
 
437
%%     <li><code>{bound, Vars}</code>, representing the variables that
 
438
%%     are bound in the subtree.</li>
 
439
%%
 
440
%%     <li><code>{free, Vars}</code>, representing the free variables in
 
441
%%     the subtree.</li>
 
442
%% </ul>
 
443
%% <code>Bindings</code> and <code>Vars</code> are ordered-set lists
 
444
%% (cf. module <code>ordsets</code>) of atoms representing variable
 
445
%% names.
 
446
%%
 
447
%% @see annotate_bindings/1
 
448
%% @see ordsets
 
449
 
 
450
annotate_bindings(Tree, Env) ->
 
451
    {Tree1, _, _} = vann(Tree, Env),
 
452
    Tree1.
 
453
 
 
454
%% =====================================================================
 
455
%% @spec annotate_bindings(Tree::syntaxTree()) -> syntaxTree()
 
456
%%
 
457
%% @doc Adds or updates annotations on nodes in a syntax tree.
 
458
%% Equivalent to <code>annotate_bindings(Tree, Bindings)</code> where
 
459
%% the top-level environment <code>Bindings</code> is taken from the
 
460
%% annotation <code>{env, Bindings}</code> on the root node of
 
461
%% <code>Tree</code>. An exception is thrown if no such annotation
 
462
%% should exist.
 
463
%%
 
464
%% @see annotate_bindings/2
 
465
 
 
466
annotate_bindings(Tree) ->
 
467
    As = erl_syntax:get_ann(Tree),
 
468
    case lists:keysearch(env, 1, As) of
 
469
        {value, {env, InVars}} ->
 
470
            annotate_bindings(Tree, InVars);
 
471
        _ ->
 
472
            erlang:fault(badarg)
 
473
    end.
 
474
 
 
475
vann(Tree, Env) ->
 
476
    case erl_syntax:type(Tree) of
 
477
        variable ->
 
478
            %% Variable use
 
479
            Bound = [],
 
480
            Free = [erl_syntax:variable_name(Tree)],
 
481
            {ann_bindings(Tree, Env, Bound, Free), Bound, Free};
 
482
        match_expr ->
 
483
            vann_match_expr(Tree, Env);
 
484
        case_expr ->
 
485
            vann_case_expr(Tree, Env);
 
486
        if_expr ->
 
487
            vann_if_expr(Tree, Env);
 
488
        cond_expr ->
 
489
            vann_cond_expr(Tree, Env);
 
490
        receive_expr ->
 
491
            vann_receive_expr(Tree, Env);
 
492
        try_expr ->
 
493
            vann_try_expr(Tree, Env);
 
494
        function ->
 
495
            vann_function(Tree, Env);
 
496
        rule ->
 
497
            vann_rule(Tree, Env);
 
498
        fun_expr ->
 
499
            vann_fun_expr(Tree, Env);
 
500
        list_comp ->
 
501
            vann_list_comp(Tree, Env);
 
502
        generator ->
 
503
            vann_generator(Tree, Env);
 
504
        block_expr ->
 
505
            vann_block_expr(Tree, Env);
 
506
        macro ->
 
507
            vann_macro(Tree, Env);
 
508
        _Type ->
 
509
            F = vann_list_join(Env),
 
510
            {Tree1, {Bound, Free}} = mapfold_subtrees(F, {[], []},
 
511
                                                      Tree),
 
512
            {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}
 
513
    end.
 
514
 
 
515
vann_list_join(Env) ->
 
516
    fun (T, {Bound, Free}) ->
 
517
            {T1, Bound1, Free1} = vann(T, Env),
 
518
            {T1, {ordsets:union(Bound, Bound1),
 
519
                  ordsets:union(Free, Free1)}}
 
520
    end.
 
521
 
 
522
vann_list(Ts, Env) ->
 
523
    lists:mapfoldl(vann_list_join(Env), {[], []}, Ts).
 
524
 
 
525
vann_function(Tree, Env) ->
 
526
    Cs = erl_syntax:function_clauses(Tree),
 
527
    {Cs1, {_, Free}} = vann_clauses(Cs, Env),
 
528
    N = erl_syntax:function_name(Tree),
 
529
    {N1, _, _} = vann(N, Env),
 
530
    Tree1 = rewrite(Tree, erl_syntax:function(N1, Cs1)),
 
531
    Bound = [],
 
532
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
533
 
 
534
vann_rule(Tree, Env) ->
 
535
    Cs = erl_syntax:rule_clauses(Tree),
 
536
    {Cs1, {_, Free}} = vann_clauses(Cs, Env),
 
537
    N = erl_syntax:rule_name(Tree),
 
538
    {N1, _, _} = vann(N, Env),
 
539
    Tree1 = rewrite(Tree, erl_syntax:rule(N1, Cs1)),
 
540
    Bound = [],
 
541
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
542
 
 
543
vann_fun_expr(Tree, Env) ->
 
544
    Cs = erl_syntax:fun_expr_clauses(Tree),
 
545
    {Cs1, {_, Free}} = vann_clauses(Cs, Env),
 
546
    Tree1 = rewrite(Tree, erl_syntax:fun_expr(Cs1)),
 
547
    Bound = [],
 
548
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
549
 
 
550
vann_match_expr(Tree, Env) ->
 
551
    E = erl_syntax:match_expr_body(Tree),
 
552
    {E1, Bound1, Free1} = vann(E, Env),
 
553
    Env1 = ordsets:union(Env, Bound1),
 
554
    P = erl_syntax:match_expr_pattern(Tree),
 
555
    {P1, Bound2, Free2} = vann_pattern(P, Env1),
 
556
    Bound = ordsets:union(Bound1, Bound2),
 
557
    Free = ordsets:union(Free1, Free2),
 
558
    Tree1 = rewrite(Tree, erl_syntax:match_expr(P1, E1)),
 
559
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
560
 
 
561
vann_case_expr(Tree, Env) ->
 
562
    E = erl_syntax:case_expr_argument(Tree),
 
563
    {E1, Bound1, Free1} = vann(E, Env),
 
564
    Env1 = ordsets:union(Env, Bound1),
 
565
    Cs = erl_syntax:case_expr_clauses(Tree),
 
566
    {Cs1, {Bound2, Free2}} = vann_clauses(Cs, Env1),
 
567
    Bound = ordsets:union(Bound1, Bound2),
 
568
    Free = ordsets:union(Free1, Free2),
 
569
    Tree1 = rewrite(Tree, erl_syntax:case_expr(E1, Cs1)),
 
570
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
571
 
 
572
vann_if_expr(Tree, Env) ->
 
573
    Cs = erl_syntax:if_expr_clauses(Tree),
 
574
    {Cs1, {Bound, Free}} = vann_clauses(Cs, Env),
 
575
    Tree1 = rewrite(Tree, erl_syntax:if_expr(Cs1)),
 
576
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
577
 
 
578
vann_cond_expr(_Tree, _Env) ->
 
579
    erlang:error({not_implemented,cond_expr}).
 
580
 
 
581
vann_try_expr(_Tree, _Env) ->
 
582
    erlang:error({not_implemented,try_expr}).
 
583
 
 
584
vann_receive_expr(Tree, Env) ->
 
585
    %% The timeout action is treated as an extra clause.
 
586
    %% Bindings in the expiry expression are local only.
 
587
    Cs = erl_syntax:receive_expr_clauses(Tree),
 
588
    Es = erl_syntax:receive_expr_action(Tree),
 
589
    C = erl_syntax:clause([], Es),
 
590
    {[C1 | Cs1], {Bound, Free1}} = vann_clauses([C | Cs], Env),
 
591
    Es1 = erl_syntax:clause_body(C1),
 
592
    {T1, _, Free2} = case erl_syntax:receive_expr_timeout(Tree) of
 
593
                         none ->
 
594
                             {none, [], []};
 
595
                         T ->
 
596
                             vann(T, Env)
 
597
                     end,
 
598
    Free = ordsets:union(Free1, Free2),
 
599
    Tree1 = rewrite(Tree, erl_syntax:receive_expr(Cs1, T1, Es1)),
 
600
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
601
 
 
602
vann_list_comp(Tree, Env) ->
 
603
    Es = erl_syntax:list_comp_body(Tree),
 
604
    {Es1, {Bound1, Free1}} = vann_list_comp_body(Es, Env),
 
605
    Env1 = ordsets:union(Env, Bound1),
 
606
    T = erl_syntax:list_comp_template(Tree),
 
607
    {T1, _, Free2} = vann(T, Env1),
 
608
    Free = ordsets:union(Free1, ordsets:subtract(Free2, Bound1)),
 
609
    Bound = [],
 
610
    Tree1 = rewrite(Tree, erl_syntax:list_comp(T1, Es1)),
 
611
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
612
 
 
613
vann_list_comp_body_join() ->
 
614
    fun (T, {Env, Bound, Free}) ->
 
615
            {T1, Bound1, Free1} = case erl_syntax:type(T) of
 
616
                                      generator ->
 
617
                                          vann_generator(T, Env);
 
618
                                      _ ->
 
619
                                          %% Bindings in filters are not
 
620
                                          %% exported to the rest of the
 
621
                                          %% body.
 
622
                                          {T2, _, Free2} = vann(T, Env),
 
623
                                          {T2, [], Free2}
 
624
                                  end,
 
625
            Env1 = ordsets:union(Env, Bound1),
 
626
            {T1, {Env1, ordsets:union(Bound, Bound1),
 
627
                  ordsets:union(Free, 
 
628
                                ordsets:subtract(Free1, Bound))}}
 
629
    end.
 
630
 
 
631
vann_list_comp_body(Ts, Env) ->
 
632
    F = vann_list_comp_body_join(),
 
633
    {Ts1, {_, Bound, Free}} = lists:mapfoldl(F, {Env, [], []}, Ts),
 
634
    {Ts1, {Bound, Free}}.
 
635
 
 
636
%% In list comprehension generators, the pattern variables are always
 
637
%% viewed as new occurrences, shadowing whatever is in the input
 
638
%% environment (thus, the pattern contains no variable uses, only
 
639
%% bindings). Bindings in the generator body are not exported.
 
640
 
 
641
vann_generator(Tree, Env) ->
 
642
    P = erl_syntax:generator_pattern(Tree),
 
643
    {P1, Bound, _} = vann_pattern(P, []),
 
644
    E = erl_syntax:generator_body(Tree),
 
645
    {E1, _, Free} = vann(E, Env),
 
646
    Tree1 = rewrite(Tree, erl_syntax:generator(P1, E1)),
 
647
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
648
 
 
649
vann_block_expr(Tree, Env) ->
 
650
    Es = erl_syntax:block_expr_body(Tree),
 
651
    {Es1, {Bound, Free}} = vann_body(Es, Env),
 
652
    Tree1 = rewrite(Tree, erl_syntax:block_expr(Es1)),
 
653
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
654
 
 
655
vann_body_join() ->
 
656
    fun (T, {Env, Bound, Free}) ->
 
657
            {T1, Bound1, Free1} = vann(T, Env),
 
658
            Env1 = ordsets:union(Env, Bound1),
 
659
            {T1, {Env1, ordsets:union(Bound, Bound1),
 
660
                  ordsets:union(Free,
 
661
                                ordsets:subtract(Free1, Bound))}}
 
662
    end.
 
663
 
 
664
vann_body(Ts, Env) ->
 
665
    {Ts1, {_, Bound, Free}} = lists:mapfoldl(vann_body_join(),
 
666
                                             {Env, [], []}, Ts),
 
667
    {Ts1, {Bound, Free}}.
 
668
 
 
669
%% Macro names must be ignored even if they happen to be variables,
 
670
%% lexically speaking.
 
671
 
 
672
vann_macro(Tree, Env) ->
 
673
    {As, {Bound, Free}} = case erl_syntax:macro_arguments(Tree) of
 
674
                              none ->
 
675
                                  {none, {[], []}};
 
676
                              As1 ->
 
677
                                  vann_list(As1, Env)
 
678
                          end,
 
679
    N = erl_syntax:macro_name(Tree),
 
680
    Tree1 = rewrite(Tree, erl_syntax:macro(N, As)),
 
681
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
682
 
 
683
vann_pattern(Tree, Env) ->
 
684
    case erl_syntax:type(Tree) of
 
685
        variable ->
 
686
            V = erl_syntax:variable_name(Tree),
 
687
            case ordsets:is_element(V, Env) of
 
688
                true ->
 
689
                    %% Variable use
 
690
                    Bound = [],
 
691
                    Free = [V],
 
692
                    {ann_bindings(Tree, Env, Bound, Free), Bound, Free};
 
693
                false ->
 
694
                    %% Variable binding
 
695
                    Bound = [V],
 
696
                    Free = [],
 
697
                    {ann_bindings(Tree, Env, Bound, Free), Bound, Free}
 
698
            end;
 
699
        match_expr ->
 
700
            %% Alias pattern
 
701
            P = erl_syntax:match_expr_pattern(Tree),
 
702
            {P1, Bound1, Free1} = vann_pattern(P, Env),
 
703
            E = erl_syntax:match_expr_body(Tree),
 
704
            {E1, Bound2, Free2} = vann_pattern(E, Env),
 
705
            Bound = ordsets:union(Bound1, Bound2),
 
706
            Free = ordsets:union(Free1, Free2),
 
707
            Tree1 = rewrite(Tree, erl_syntax:match_expr(P1, E1)),
 
708
            {ann_bindings(Tree1, Env, Bound, Free), Bound, Free};
 
709
        macro ->
 
710
            %% The macro name must be ignored. The arguments are treated
 
711
            %% as patterns.
 
712
            {As, {Bound, Free}} =
 
713
                case erl_syntax:macro_arguments(Tree) of
 
714
                    none ->
 
715
                        {none, {[], []}};
 
716
                    As1 ->
 
717
                        vann_patterns(As1, Env)
 
718
                end,
 
719
            N = erl_syntax:macro_name(Tree),
 
720
            Tree1 = rewrite(Tree, erl_syntax:macro(N, As)),
 
721
            {ann_bindings(Tree1, Env, Bound, Free), Bound, Free};
 
722
        _Type ->
 
723
            F = vann_patterns_join(Env),
 
724
            {Tree1, {Bound, Free}} = mapfold_subtrees(F, {[], []},
 
725
                                                      Tree),
 
726
            {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}
 
727
    end.
 
728
 
 
729
vann_patterns_join(Env) ->
 
730
    fun (T, {Bound, Free}) ->
 
731
            {T1, Bound1, Free1} = vann_pattern(T, Env),
 
732
            {T1, {ordsets:union(Bound, Bound1),
 
733
                  ordsets:union(Free, Free1)}}
 
734
    end.
 
735
 
 
736
vann_patterns(Ps, Env) ->
 
737
    lists:mapfoldl(vann_patterns_join(Env), {[], []}, Ps).
 
738
 
 
739
vann_clause(C, Env) ->
 
740
    {Ps, {Bound1, Free1}} = vann_patterns(erl_syntax:clause_patterns(C),
 
741
                                          Env),
 
742
    Env1 = ordsets:union(Env, Bound1),
 
743
    %% Guards cannot add bindings
 
744
    {G1, _, Free2} = case erl_syntax:clause_guard(C) of
 
745
                         none ->
 
746
                             {none, [], []};
 
747
                         G ->
 
748
                             vann(G, Env1)
 
749
                     end,
 
750
    {Es, {Bound2, Free3}} = vann_body(erl_syntax:clause_body(C), Env1),
 
751
    Bound = ordsets:union(Bound1, Bound2),
 
752
    Free = ordsets:union(Free1,
 
753
                         ordsets:subtract(ordsets:union(Free2, Free3),
 
754
                                          Bound1)),
 
755
    Tree1 = rewrite(C, erl_syntax:clause(Ps, G1, Es)),
 
756
    {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
 
757
 
 
758
vann_clauses_join(Env) ->
 
759
    fun (C, {Bound, Free}) ->
 
760
            {C1, Bound1, Free1} = vann_clause(C, Env),
 
761
            {C1, {ordsets:intersection(Bound, Bound1),
 
762
                  ordsets:union(Free, Free1)}};
 
763
        (C, false) ->
 
764
            {C1, Bound, Free} = vann_clause(C, Env),
 
765
            {C1, {Bound, Free}}
 
766
    end.
 
767
 
 
768
vann_clauses(Cs, Env) ->
 
769
    lists:mapfoldl(vann_clauses_join(Env), false, Cs).
 
770
 
 
771
ann_bindings(Tree, Env, Bound, Free) ->
 
772
    As0 = erl_syntax:get_ann(Tree),
 
773
    As1 = [{env, Env},
 
774
           {bound, Bound},
 
775
           {free, Free}
 
776
           | delete_binding_anns(As0)],
 
777
    erl_syntax:set_ann(Tree, As1).
 
778
 
 
779
delete_binding_anns([{env, _} | As]) ->
 
780
    delete_binding_anns(As);
 
781
delete_binding_anns([{bound, _} | As]) ->
 
782
    delete_binding_anns(As);
 
783
delete_binding_anns([{free, _} | As]) ->
 
784
    delete_binding_anns(As);
 
785
delete_binding_anns([A | As]) ->
 
786
    [A | delete_binding_anns(As)];
 
787
delete_binding_anns([]) ->
 
788
    [].
 
789
 
 
790
 
 
791
%% =====================================================================
 
792
%% @spec is_fail_expr(Tree::syntaxTree()) -> bool()
 
793
%%
 
794
%% @doc Returns <code>true</code> if <code>Tree</code> represents an
 
795
%% expression which never terminates normally. Note that the reverse
 
796
%% does not apply. Currently, the detected cases are calls to
 
797
%% <code>exit/1</code>, <code>throw/1</code>,
 
798
%% <code>erlang:fault/1</code> and <code>erlang:fault/2</code>.
 
799
%%
 
800
%% @see erlang:exit/1
 
801
%% @see erlang:throw/1
 
802
%% @see erlang:fault/1
 
803
%% @see erlang:fault/2
 
804
 
 
805
is_fail_expr(E) ->          
 
806
    case erl_syntax:type(E) of
 
807
        application ->
 
808
            N = length(erl_syntax:application_arguments(E)),
 
809
            F = erl_syntax:application_operator(E),
 
810
            case catch {ok, analyze_function_name(F)} of
 
811
                syntax_error ->
 
812
                    false;
 
813
                {ok, exit} when N == 1 ->
 
814
                    true;
 
815
                {ok, throw} when N == 1 ->
 
816
                    true;
 
817
                {ok, {erlang, exit}} when N == 1 ->
 
818
                    true;
 
819
                {ok, {erlang, throw}} when N == 1 ->
 
820
                    true;
 
821
                {ok, {erlang, error}} when N == 1 ->
 
822
                    true;
 
823
                {ok, {erlang, error}} when N == 2 ->
 
824
                    true;
 
825
                {ok, {erlang, fault}} when N == 1 ->
 
826
                    true;
 
827
                {ok, {erlang, fault}} when N == 2 ->
 
828
                    true;
 
829
                _ ->
 
830
                    false
 
831
            end;
 
832
        _ ->
 
833
            false
 
834
    end.
 
835
 
 
836
 
 
837
%% =====================================================================
 
838
%% @spec analyze_forms(Forms) -> [{Key, term()}]
 
839
%%
 
840
%%          Forms = syntaxTree() | [syntaxTree()]
 
841
%%          Key = attributes | errors | exports | functions | imports
 
842
%%                | module | records | rules | warnings
 
843
%%
 
844
%% @doc Analyzes a sequence of "program forms". The given
 
845
%% <code>Forms</code> may be a single syntax tree of type
 
846
%% <code>form_list</code>, or a list of "program form" syntax trees. The
 
847
%% returned value is a list of pairs <code>{Key, Info}</code>, where
 
848
%% each value of <code>Key</code> occurs at most once in the list; the
 
849
%% absence of a particular key indicates that there is no well-defined
 
850
%% value for that key.
 
851
%%
 
852
%% <p>Each entry in the resulting list contains the following
 
853
%% corresponding information about the program forms:
 
854
%% <dl>
 
855
%%     <dt><code>{attributes, Attributes}</code></dt>
 
856
%%       <dd><ul>
 
857
%%         <li><code>Attributes = [{atom(), term()}]</code></li>
 
858
%%       </ul>
 
859
%%       <code>Attributes</code> is a list of pairs representing the
 
860
%%       names and corresponding values of all so-called "wild"
 
861
%%       attributes (as e.g. "<code>-compile(...)</code>") occurring in
 
862
%%       <code>Forms</code> (cf. <code>analyze_wild_attribute/1</code>).
 
863
%%       We do not guarantee that each name occurs at most once in the
 
864
%%       list. The order of listing is not defined.</dd>
 
865
%%
 
866
%%     <dt><code>{errors, Errors}</code></dt>
 
867
%%       <dd><ul>
 
868
%%         <li><code>Errors = [term()]</code></li>
 
869
%%       </ul>
 
870
%%       <code>Errors</code> is the list of error descriptors of all
 
871
%%       <code>error_marker</code> nodes that occur in
 
872
%%       <code>Forms</code>. The order of listing is not defined.</dd>
 
873
%%
 
874
%%     <dt><code>{exports, Exports}</code></dt>
 
875
%%       <dd><ul>
 
876
%%          <li><code>Exports = [FunctionName]</code></li>
 
877
%%          <li><code>FunctionName = atom()
 
878
%%                    | {atom(), integer()}
 
879
%%                    | {ModuleName, FunctionName}</code></li>
 
880
%%          <li><code>ModuleName = atom()</code></li>
 
881
%%       </ul>
 
882
%%       <code>Exports</code> is a list of representations of those
 
883
%%       function names that are listed by export declaration attributes
 
884
%%       in <code>Forms</code> (cf.
 
885
%%       <code>analyze_export_attribute/1</code>). We do not guarantee
 
886
%%       that each name occurs at most once in the list. The order of
 
887
%%       listing is not defined.</dd>
 
888
%%
 
889
%%     <dt><code>{functions, Functions}</code></dt>
 
890
%%       <dd><ul>
 
891
%%          <li><code>Functions = [{atom(), integer()}]</code></li>
 
892
%%       </ul>
 
893
%%       <code>Functions</code> is a list of the names of the functions
 
894
%%       that are defined in <code>Forms</code> (cf.
 
895
%%       <code>analyze_function/1</code>). We do not guarantee that each
 
896
%%       name occurs at most once in the list. The order of listing is
 
897
%%       not defined.</dd>
 
898
%%
 
899
%%     <dt><code>{imports, Imports}</code></dt>
 
900
%%       <dd><ul>
 
901
%%          <li><code>Imports = [{Module, Names}]</code></li>
 
902
%%          <li><code>Module = atom()</code></li>
 
903
%%          <li><code>Names = [FunctionName]</code></li>
 
904
%%          <li><code>FunctionName = atom()
 
905
%%                    | {atom(), integer()}
 
906
%%                    | {ModuleName, FunctionName}</code></li>
 
907
%%          <li><code>ModuleName = atom()</code></li>
 
908
%%       </ul>
 
909
%%       <code>Imports</code> is a list of pairs representing those
 
910
%%       module names and corresponding function names that are listed
 
911
%%       by import declaration attributes in <code>Forms</code> (cf.
 
912
%%       <code>analyze_import_attribute/1</code>), where each
 
913
%%       <code>Module</code> occurs at most once in
 
914
%%       <code>Imports</code>. We do not guarantee that each name occurs
 
915
%%       at most once in the lists of function names. The order of
 
916
%%       listing is not defined.</dd>
 
917
%%
 
918
%%     <dt><code>{module, ModuleName}</code></dt>
 
919
%%       <dd><ul>
 
920
%%          <li><code>ModuleName = atom()</code></li>
 
921
%%       </ul>
 
922
%%       <code>ModuleName</code> is the name declared by a module
 
923
%%       attribute in <code>Forms</code>. If no module name is defined
 
924
%%       in <code>Forms</code>, the result will contain no entry for the
 
925
%%       <code>module</code> key. If multiple module name declarations
 
926
%%       should occur, all but the first will be ignored.</dd>
 
927
%%
 
928
%%     <dt><code>{records, Records}</code></dt>
 
929
%%       <dd><ul>
 
930
%%          <li><code>Records = [{atom(), Fields}]</code></li>
 
931
%%          <li><code>Fields = [{atom(), Default}]</code></li>
 
932
%%          <li><code>Default = none | syntaxTree()</code></li>
 
933
%%       </ul>
 
934
%%       <code>Records</code> is a list of pairs representing the names
 
935
%%       and corresponding field declarations of all record declaration
 
936
%%       attributes occurring in <code>Forms</code>. For fields declared
 
937
%%       without a default value, the corresponding value for
 
938
%%       <code>Default</code> is the atom <code>none</code> (cf.
 
939
%%       <code>analyze_record_attribute/1</code>). We do not guarantee
 
940
%%       that each record name occurs at most once in the list. The
 
941
%%       order of listing is not defined.</dd>
 
942
%%
 
943
%%     <dt><code>{rules, Rules}</code></dt>
 
944
%%       <dd><ul>
 
945
%%          <li><code>Rules = [{atom(), integer()}]</code></li>
 
946
%%       </ul>
 
947
%%       <code>Rules</code> is a list of the names of the rules that are
 
948
%%       defined in <code>Forms</code> (cf.
 
949
%%       <code>analyze_rule/1</code>). We do not guarantee that each
 
950
%%       name occurs at most once in the list. The order of listing is
 
951
%%       not defined.</dd>
 
952
%%
 
953
%%     <dt><code>{warnings, Warnings}</code></dt>
 
954
%%       <dd><ul>
 
955
%%          <li><code>Warnings = [term()]</code></li>
 
956
%%       </ul>
 
957
%%       <code>Warnings</code> is the list of error descriptors of all
 
958
%%       <code>warning_marker</code> nodes that occur in
 
959
%%       <code>Forms</code>. The order of listing is not defined.</dd>
 
960
%% </dl></p>
 
961
%%
 
962
%% <p>The evaluation throws <code>syntax_error</code> if an ill-formed
 
963
%% Erlang construct is encountered.</p>
 
964
%%
 
965
%% @see analyze_wild_attribute/1
 
966
%% @see analyze_export_attribute/1
 
967
%% @see analyze_import_attribute/1
 
968
%% @see analyze_record_attribute/1
 
969
%% @see analyze_function/1
 
970
%% @see analyze_rule/1
 
971
%% @see erl_syntax:error_marker_info/1
 
972
%% @see erl_syntax:warning_marker_info/1
 
973
 
 
974
analyze_forms(Forms) when list(Forms) ->
 
975
    finfo_to_list(lists:foldl(fun collect_form/2, new_finfo(), Forms));
 
976
analyze_forms(Forms) ->
 
977
    analyze_forms(
 
978
      erl_syntax:form_list_elements(
 
979
        erl_syntax:flatten_form_list(Forms))).
 
980
 
 
981
collect_form(Node, Info) ->
 
982
    case analyze_form(Node) of
 
983
        {attribute, {Name, Data}} ->
 
984
            collect_attribute(Name, Data, Info);
 
985
        {attribute, preprocessor} ->
 
986
            Info;
 
987
        {function, Name} ->
 
988
            finfo_add_function(Name, Info);
 
989
        {rule, Name} ->
 
990
            finfo_add_rule(Name, Info);
 
991
        {error_marker, Data} ->
 
992
            finfo_add_error(Data, Info);
 
993
        {warning_marker, Data} ->
 
994
            finfo_add_warning(Data, Info);
 
995
        _ ->
 
996
            Info
 
997
    end.
 
998
 
 
999
collect_attribute(module, M, Info) ->
 
1000
    finfo_set_module(M, Info);
 
1001
collect_attribute(export, L, Info) ->
 
1002
    finfo_add_exports(L, Info);
 
1003
collect_attribute(import, {M, L}, Info) ->
 
1004
    finfo_add_imports(M, L, Info);
 
1005
collect_attribute(import, M, Info) ->
 
1006
    finfo_add_module_import(M, Info);
 
1007
collect_attribute(file, _, Info) ->
 
1008
    Info;
 
1009
collect_attribute(record, {R, L}, Info) ->
 
1010
    finfo_add_record(R, L, Info);
 
1011
collect_attribute(_, {N, V}, Info) ->
 
1012
    finfo_add_attribute(N, V, Info).
 
1013
 
 
1014
%% Abstract datatype for collecting module information.
 
1015
 
 
1016
-record(forms, {module, exports, module_imports, imports, attributes,
 
1017
                records, errors, warnings, functions, rules}).
 
1018
 
 
1019
new_finfo() ->
 
1020
    #forms{module = none,
 
1021
           exports = [],
 
1022
           module_imports = [],
 
1023
           imports = [],
 
1024
           attributes = [],
 
1025
           records = [],
 
1026
           errors = [],
 
1027
           warnings = [],
 
1028
           functions = [],
 
1029
           rules = []
 
1030
          }.
 
1031
 
 
1032
finfo_set_module(Name, Info) ->
 
1033
    case Info#forms.module of
 
1034
        none ->
 
1035
            Info#forms{module = {value, Name}};
 
1036
        {value, _} ->
 
1037
            Info
 
1038
    end.
 
1039
 
 
1040
finfo_add_exports(L, Info) ->
 
1041
    Info#forms{exports = L ++ Info#forms.exports}.
 
1042
 
 
1043
finfo_add_module_import(M, Info) ->
 
1044
    Info#forms{module_imports = [M | Info#forms.module_imports]}.
 
1045
 
 
1046
finfo_add_imports(M, L, Info) ->
 
1047
    Es = Info#forms.imports,
 
1048
    case lists:keysearch(M, 1, Es) of
 
1049
        {value, {_, L1}} ->
 
1050
            Es1 = lists:keyreplace(M, 1, Es, {M, L ++ L1}),
 
1051
            Info#forms{imports = Es1};
 
1052
        false ->
 
1053
            Info#forms{imports = [{M, L} | Es]}
 
1054
    end.
 
1055
 
 
1056
finfo_add_attribute(Name, Val, Info) ->
 
1057
    Info#forms{attributes = [{Name, Val} | Info#forms.attributes]}.
 
1058
 
 
1059
finfo_add_record(R, L, Info) ->
 
1060
    Info#forms{records = [{R, L} | Info#forms.records]}.
 
1061
 
 
1062
finfo_add_error(R, Info) ->
 
1063
    Info#forms{errors = [R | Info#forms.errors]}.
 
1064
 
 
1065
finfo_add_warning(R, Info) ->
 
1066
    Info#forms{warnings = [R | Info#forms.warnings]}.
 
1067
 
 
1068
finfo_add_function(F, Info) ->
 
1069
    Info#forms{functions = [F | Info#forms.functions]}.
 
1070
 
 
1071
finfo_add_rule(F, Info) ->
 
1072
    Info#forms{rules = [F | Info#forms.rules]}.
 
1073
 
 
1074
finfo_to_list(Info) ->
 
1075
    [{Key, Value}
 
1076
     || {Key, {value, Value}} <-
 
1077
            [{module, Info#forms.module},
 
1078
             {exports, list_value(Info#forms.exports)},
 
1079
             {imports, list_value(Info#forms.imports)},
 
1080
             {module_imports, list_value(Info#forms.module_imports)},
 
1081
             {attributes, list_value(Info#forms.attributes)},
 
1082
             {records, list_value(Info#forms.records)},
 
1083
             {errors, list_value(Info#forms.errors)},
 
1084
             {warnings, list_value(Info#forms.warnings)},
 
1085
             {functions, list_value(Info#forms.functions)},
 
1086
             {rules, list_value(Info#forms.rules)}
 
1087
            ]].
 
1088
 
 
1089
list_value([]) ->
 
1090
    none;
 
1091
list_value(List) ->
 
1092
    {value, List}.
 
1093
 
 
1094
 
 
1095
%% =====================================================================
 
1096
%% @spec analyze_form(Node::syntaxTree()) -> {atom(), term()} | atom()
 
1097
%%
 
1098
%% @doc Analyzes a "source code form" node. If <code>Node</code> is a
 
1099
%% "form" type (cf. <code>erl_syntax:is_form/1</code>), the returned
 
1100
%% value is a tuple <code>{Type, Info}</code> where <code>Type</code> is
 
1101
%% the node type and <code>Info</code> depends on <code>Type</code>, as
 
1102
%% follows:
 
1103
%% <dl>
 
1104
%%   <dt><code>{attribute, Info}</code></dt>
 
1105
%%
 
1106
%%      <dd>where <code>Info = analyze_attribute(Node)</code>.</dd>
 
1107
%%
 
1108
%%   <dt><code>{error_marker, Info}</code></dt>
 
1109
%%
 
1110
%%      <dd>where <code>Info =
 
1111
%%      erl_syntax:error_marker_info(Node)</code>.</dd>
 
1112
%%
 
1113
%%   <dt><code>{function, Info}</code></dt>
 
1114
%%
 
1115
%%          <dd>where <code>Info = analyze_function(Node)</code>.</dd>
 
1116
%%
 
1117
%%   <dt><code>{rule, Info}</code></dt>
 
1118
%%
 
1119
%%          <dd>where <code>Info = analyze_rule(Node)</code>.</dd>
 
1120
%%
 
1121
%%   <dt><code>{warning_marker, Info}</code></dt>
 
1122
%%
 
1123
%%          <dd>where <code>Info =
 
1124
%%          erl_syntax:warning_marker_info(Node)</code>.</dd>
 
1125
%% </dl>
 
1126
%% For other types of forms, only the node type is returned.
 
1127
%%
 
1128
%% <p>The evaluation throws <code>syntax_error</code> if
 
1129
%% <code>Node</code> is not well-formed.</p>
 
1130
%%
 
1131
%% @see analyze_attribute/1
 
1132
%% @see analyze_function/1
 
1133
%% @see analyze_rule/1
 
1134
%% @see erl_syntax:is_form/1
 
1135
%% @see erl_syntax:error_marker_info/1
 
1136
%% @see erl_syntax:warning_marker_info/1
 
1137
 
 
1138
analyze_form(Node) ->
 
1139
    case erl_syntax:type(Node) of
 
1140
        attribute ->
 
1141
            {attribute, analyze_attribute(Node)};
 
1142
        function ->
 
1143
            {function, analyze_function(Node)};
 
1144
        rule ->
 
1145
            {rule, analyze_rule(Node)};
 
1146
        error_marker ->
 
1147
            {error_marker, erl_syntax:error_marker_info(Node)};
 
1148
        warning_marker ->
 
1149
            {warning_marker, erl_syntax:warning_marker_info(Node)};
 
1150
        _ ->
 
1151
            case erl_syntax:is_form(Node) of
 
1152
                true ->
 
1153
                    erl_syntax:type(Node);
 
1154
                false ->
 
1155
                    throw(syntax_error)
 
1156
            end
 
1157
    end.
 
1158
 
 
1159
%% =====================================================================
 
1160
%% @spec analyze_attribute(Node::syntaxTree()) ->
 
1161
%%           preprocessor | {atom(), atom()}
 
1162
%%
 
1163
%% @doc Analyzes an attribute node. If <code>Node</code> represents a
 
1164
%% preprocessor directive, the atom <code>preprocessor</code> is
 
1165
%% returned. Otherwise, if <code>Node</code> represents a module
 
1166
%% attribute "<code>-<em>Name</em>...</code>", a tuple <code>{Name,
 
1167
%% Info}</code> is returned, where <code>Info</code> depends on
 
1168
%% <code>Name</code>, as follows:
 
1169
%% <dl>
 
1170
%%     <dt><code>{module, Info}</code></dt>
 
1171
%%
 
1172
%%          <dd>where <code>Info =
 
1173
%%          analyze_module_attribute(Node)</code>.</dd>
 
1174
%%
 
1175
%%     <dt><code>{export, Info}</code></dt>
 
1176
%%
 
1177
%%          <dd>where <code>Info =
 
1178
%%          analyze_export_attribute(Node)</code>.</dd>
 
1179
%%
 
1180
%%     <dt><code>{import, Info}</code></dt>
 
1181
%%
 
1182
%%          <dd>where <code>Info =
 
1183
%%          analyze_import_attribute(Node)</code>.</dd>
 
1184
%%
 
1185
%%     <dt><code>{file, Info}</code></dt>
 
1186
%%
 
1187
%%          <dd>where <code>Info =
 
1188
%%          analyze_file_attribute(Node)</code>.</dd>
 
1189
%%
 
1190
%%     <dt><code>{record, Info}</code></dt>
 
1191
%%
 
1192
%%          <dd>where <code>Info =
 
1193
%%          analyze_record_attribute(Node)</code>.</dd>
 
1194
%%
 
1195
%%     <dt><code>{Name, Info}</code></dt>
 
1196
%%
 
1197
%%          <dd>where <code>{Name, Info} =
 
1198
%%          analyze_wild_attribute(Node)</code>.</dd>
 
1199
%% </dl>
 
1200
%% The evaluation throws <code>syntax_error</code> if <code>Node</code>
 
1201
%% does not represent a well-formed module attribute.
 
1202
%%
 
1203
%% @see analyze_module_attribute/1
 
1204
%% @see analyze_export_attribute/1
 
1205
%% @see analyze_import_attribute/1
 
1206
%% @see analyze_file_attribute/1
 
1207
%% @see analyze_record_attribute/1
 
1208
%% @see analyze_wild_attribute/1
 
1209
 
 
1210
analyze_attribute(Node) ->
 
1211
    Name = erl_syntax:attribute_name(Node),
 
1212
    case erl_syntax:type(Name) of
 
1213
        atom ->
 
1214
            case erl_syntax:atom_value(Name) of
 
1215
                define -> preprocessor;
 
1216
                undef -> preprocessor;
 
1217
                include -> preprocessor;
 
1218
                include_lib -> preprocessor;
 
1219
                ifdef -> preprocessor;
 
1220
                ifndef -> preprocessor;
 
1221
                else -> preprocessor;
 
1222
                endif -> preprocessor;
 
1223
                A ->
 
1224
                    {A, analyze_attribute(A, Node)}
 
1225
            end;
 
1226
        _ ->
 
1227
            throw(syntax_error)
 
1228
    end.
 
1229
 
 
1230
analyze_attribute(module, Node) ->
 
1231
    analyze_module_attribute(Node);
 
1232
analyze_attribute(export, Node) ->
 
1233
    analyze_export_attribute(Node);
 
1234
analyze_attribute(import, Node) ->
 
1235
    analyze_import_attribute(Node);
 
1236
analyze_attribute(file, Node) ->
 
1237
    analyze_file_attribute(Node);
 
1238
analyze_attribute(record, Node) ->
 
1239
    analyze_record_attribute(Node);
 
1240
analyze_attribute(define, _Node) ->
 
1241
    define;
 
1242
analyze_attribute(_, Node) ->
 
1243
    %% A "wild" attribute (such as e.g. a `compile' directive).
 
1244
    analyze_wild_attribute(Node).
 
1245
 
 
1246
 
 
1247
%% =====================================================================
 
1248
%% @spec analyze_module_attribute(Node::syntaxTree()) -> atom()
 
1249
%%
 
1250
%% @doc Returns the module name declared by a module attribute.
 
1251
%%
 
1252
%% <p>The evaluation throws <code>syntax_error</code> if
 
1253
%% <code>Node</code> does not represent a well-formed module
 
1254
%% attribute.</p>
 
1255
%%
 
1256
%% @see analyze_attribute/1
 
1257
 
 
1258
analyze_module_attribute(Node) ->
 
1259
    case erl_syntax:type(Node) of
 
1260
        attribute ->
 
1261
            case erl_syntax:attribute_arguments(Node) of
 
1262
                [M] ->
 
1263
                    module_name_to_atom(M);
 
1264
                [M, L] ->
 
1265
                    M1 = module_name_to_atom(M),
 
1266
                    L1 = analyze_variable_list(L),
 
1267
                    {M1, L1};
 
1268
                _ ->
 
1269
                    throw(syntax_error)
 
1270
            end;
 
1271
        _ ->
 
1272
            throw(syntax_error)
 
1273
    end.
 
1274
 
 
1275
analyze_variable_list(Node) ->
 
1276
    case erl_syntax:is_proper_list(Node) of
 
1277
        true ->
 
1278
            [erl_syntax:variable_name(V)
 
1279
             || V <- erl_syntax:list_elements(Node)];
 
1280
        false ->
 
1281
            throw(syntax_error)
 
1282
    end.
 
1283
 
 
1284
 
 
1285
%% =====================================================================
 
1286
%% @spec analyze_export_attribute(Node::syntaxTree()) -> [FunctionName]
 
1287
%%
 
1288
%%          FunctionName = atom() | {atom(), integer()}
 
1289
%%                       | {ModuleName, FunctionName}
 
1290
%%          ModuleName = atom()
 
1291
%%
 
1292
%% @doc Returns the list of function names declared by an export
 
1293
%% attribute. We do not guarantee that each name occurs at most once in
 
1294
%% the list. The order of listing is not defined.
 
1295
%%
 
1296
%% <p>The evaluation throws <code>syntax_error</code> if
 
1297
%% <code>Node</code> does not represent a well-formed export
 
1298
%% attribute.</p>
 
1299
%%
 
1300
%% @see analyze_attribute/1
 
1301
 
 
1302
analyze_export_attribute(Node) ->
 
1303
    case erl_syntax:type(Node) of
 
1304
        attribute ->
 
1305
            case erl_syntax:attribute_arguments(Node) of
 
1306
                [L] ->
 
1307
                    analyze_function_name_list(L);
 
1308
                _ ->
 
1309
                    throw(syntax_error)
 
1310
            end;
 
1311
        _ ->
 
1312
            throw(syntax_error)
 
1313
    end.
 
1314
 
 
1315
analyze_function_name_list(Node) ->
 
1316
    case erl_syntax:is_proper_list(Node) of
 
1317
        true ->
 
1318
            [analyze_function_name(F)
 
1319
             || F <- erl_syntax:list_elements(Node)];
 
1320
        false ->
 
1321
            throw(syntax_error)
 
1322
    end.
 
1323
 
 
1324
 
 
1325
%% =====================================================================
 
1326
%% @spec analyze_function_name(Node::syntaxTree()) -> FunctionName
 
1327
%%
 
1328
%%          FunctionName = atom() | {atom(), integer()}
 
1329
%%                       | {ModuleName, FunctionName}
 
1330
%%          ModuleName = atom()
 
1331
%%
 
1332
%% @doc Returns the function name represented by a syntax tree. If
 
1333
%% <code>Node</code> represents a function name, such as
 
1334
%% "<code>foo/1</code>" or "<code>bloggs:fred/2</code>", a uniform
 
1335
%% representation of that name is returned. Different nestings of arity
 
1336
%% and module name qualifiers in the syntax tree does not affect the
 
1337
%% result.
 
1338
%%
 
1339
%% <p>The evaluation throws <code>syntax_error</code> if
 
1340
%% <code>Node</code> does not represent a well-formed function name.</p>
 
1341
 
 
1342
analyze_function_name(Node) ->
 
1343
    case erl_syntax:type(Node) of
 
1344
        atom ->
 
1345
            erl_syntax:atom_value(Node);
 
1346
        arity_qualifier ->
 
1347
            A = erl_syntax:arity_qualifier_argument(Node),
 
1348
            case erl_syntax:type(A) of
 
1349
                integer ->
 
1350
                    F = erl_syntax:arity_qualifier_body(Node),
 
1351
                    F1 = analyze_function_name(F),
 
1352
                    append_arity(erl_syntax:integer_value(A), F1);
 
1353
                _ ->
 
1354
                    throw(syntax_error)
 
1355
            end;
 
1356
        module_qualifier ->
 
1357
            M = erl_syntax:module_qualifier_argument(Node),
 
1358
            case erl_syntax:type(M) of
 
1359
                atom ->
 
1360
                    F = erl_syntax:module_qualifier_body(Node),
 
1361
                    F1 = analyze_function_name(F),
 
1362
                    {erl_syntax:atom_value(M), F1};
 
1363
                _ ->
 
1364
                    throw(syntax_error)
 
1365
            end;
 
1366
        _ ->
 
1367
            throw(syntax_error)
 
1368
    end.
 
1369
 
 
1370
append_arity(A, {Module, Name}) ->
 
1371
    {Module, append_arity(A, Name)};
 
1372
append_arity(A, Name) when atom(Name) ->
 
1373
    {Name, A};
 
1374
append_arity(A, A) ->
 
1375
    A;
 
1376
append_arity(_A, Name) ->
 
1377
    Name.    % quietly drop extra arity in case of conflict
 
1378
 
 
1379
 
 
1380
%% =====================================================================
 
1381
%% @spec analyze_import_attribute(Node::syntaxTree()) ->
 
1382
%%           {atom(), [FunctionName]} | atom()
 
1383
%%
 
1384
%%          FunctionName = atom() | {atom(), integer()}
 
1385
%%                       | {ModuleName, FunctionName}
 
1386
%%          ModuleName = atom()
 
1387
%%
 
1388
%% @doc Returns the module name and (if present) list of function names
 
1389
%% declared by an import attribute. The returned value is an atom
 
1390
%% <code>Module</code> or a pair <code>{Module, Names}</code>, where
 
1391
%% <code>Names</code> is a list of function names declared as imported
 
1392
%% from the module named by <code>Module</code>. We do not guarantee
 
1393
%% that each name occurs at most once in <code>Names</code>. The order
 
1394
%% of listing is not defined.
 
1395
%%
 
1396
%% <p>The evaluation throws <code>syntax_error</code> if
 
1397
%% <code>Node</code> does not represent a well-formed import
 
1398
%% attribute.</p>
 
1399
%%
 
1400
%% @see analyze_attribute/1
 
1401
 
 
1402
analyze_import_attribute(Node) ->
 
1403
    case erl_syntax:type(Node) of
 
1404
        attribute ->
 
1405
            case erl_syntax:attribute_arguments(Node) of
 
1406
                [M] ->
 
1407
                    module_name_to_atom(M);
 
1408
                [M, L] ->
 
1409
                    M1 = module_name_to_atom(M),
 
1410
                    L1 = analyze_function_name_list(L),
 
1411
                    {M1, L1};
 
1412
                _ ->
 
1413
                    throw(syntax_error)
 
1414
            end;
 
1415
        _ ->
 
1416
            throw(syntax_error)
 
1417
    end.
 
1418
 
 
1419
 
 
1420
%% =====================================================================
 
1421
%% @spec analyze_wild_attribute(Node::syntaxTree()) -> {atom(), term()}
 
1422
%%
 
1423
%% @doc Returns the name and value of a "wild" attribute. The result is
 
1424
%% the pair <code>{Name, Value}</code>, if <code>Node</code> represents
 
1425
%% "<code>-Name(Value)</code>".
 
1426
%%
 
1427
%% <p>Note that no checking is done whether <code>Name</code> is a
 
1428
%% reserved attribute name such as <code>module</code> or
 
1429
%% <code>export</code>: it is assumed that the attribute is "wild".</p>
 
1430
%%
 
1431
%% <p>The evaluation throws <code>syntax_error</code> if
 
1432
%% <code>Node</code> does not represent a well-formed wild
 
1433
%% attribute.</p>
 
1434
%%
 
1435
%% @see analyze_attribute/1
 
1436
 
 
1437
analyze_wild_attribute(Node) ->
 
1438
    case erl_syntax:type(Node) of
 
1439
        attribute ->
 
1440
            N = erl_syntax:attribute_name(Node),
 
1441
            case erl_syntax:type(N) of
 
1442
                atom ->
 
1443
                    case erl_syntax:attribute_arguments(Node) of
 
1444
                        [V] ->
 
1445
                            {erl_syntax:atom_value(N),
 
1446
                             erl_syntax:concrete(V)};
 
1447
                        _ ->
 
1448
                            throw(syntax_error)
 
1449
                    end;
 
1450
                _ ->
 
1451
                    throw(syntax_error)
 
1452
            end;
 
1453
        _ ->
 
1454
            throw(syntax_error)
 
1455
    end.
 
1456
 
 
1457
 
 
1458
%% =====================================================================
 
1459
%% @spec analyze_record_attribute(Node::syntaxTree()) ->
 
1460
%%           {atom(), Fields}
 
1461
%%
 
1462
%%          Fields = [{atom(), none | syntaxTree()}]
 
1463
%%
 
1464
%% @doc Returns the name and the list of fields of a record declaration
 
1465
%% attribute. The result is a pair <code>{Name, Fields}</code>, if
 
1466
%% <code>Node</code> represents "<code>-record(Name, {...}).</code>",
 
1467
%% where <code>Fields</code> is a list of pairs <code>{Label,
 
1468
%% Default}</code> for each field "<code>Label</code>" or "<code>Label =
 
1469
%% <em>Default</em></code>" in the declaration, listed in left-to-right
 
1470
%% order. If the field has no default-value declaration, the value for
 
1471
%% <code>Default</code> will be the atom <code>none</code>. We do not
 
1472
%% guarantee that each label occurs at most one in the list.
 
1473
%%
 
1474
%% <p>The evaluation throws <code>syntax_error</code> if
 
1475
%% <code>Node</code> does not represent a well-formed record declaration
 
1476
%% attribute.</p>
 
1477
%%
 
1478
%% @see analyze_attribute/1
 
1479
%% @see analyze_record_field/1
 
1480
 
 
1481
analyze_record_attribute(Node) ->
 
1482
    case erl_syntax:type(Node) of
 
1483
        attribute ->
 
1484
            case erl_syntax:attribute_arguments(Node) of
 
1485
                [R, T] ->
 
1486
                    case erl_syntax:type(R) of
 
1487
                        atom ->
 
1488
                            Es = analyze_record_attribute_tuple(T),
 
1489
                            {erl_syntax:atom_value(R), Es};
 
1490
                        _ ->
 
1491
                            throw(syntax_error)
 
1492
                    end;
 
1493
                _ ->
 
1494
                    throw(syntax_error)
 
1495
            end;
 
1496
        _ ->
 
1497
            throw(syntax_error)
 
1498
    end.
 
1499
 
 
1500
analyze_record_attribute_tuple(Node) ->
 
1501
    case erl_syntax:type(Node) of
 
1502
        tuple ->
 
1503
            [analyze_record_field(F)
 
1504
             || F <- erl_syntax:tuple_elements(Node)];
 
1505
        _ ->
 
1506
            throw(syntax_error)
 
1507
    end.
 
1508
 
 
1509
 
 
1510
%% =====================================================================
 
1511
%% @spec analyze_record_expr(Node::syntaxTree()) ->
 
1512
%%     {atom(), Info} | atom()
 
1513
%%
 
1514
%%    Info = {atom(), [{atom(), Value}]} | {atom(), atom()} | atom()
 
1515
%%    Value = none | syntaxTree()
 
1516
%%
 
1517
%% @doc Returns the record name and field name/names of a record
 
1518
%% expression. If <code>Node</code> has type <code>record_expr</code>,
 
1519
%% <code>record_index_expr</code> or <code>record_access</code>, a pair
 
1520
%% <code>{Type, Info}</code> is returned, otherwise an atom
 
1521
%% <code>Type</code> is returned. <code>Type</code> is the node type of
 
1522
%% <code>Node</code>, and <code>Info</code> depends on
 
1523
%% <code>Type</code>, as follows:
 
1524
%% <dl>
 
1525
%%   <dt><code>record_expr</code>:</dt>
 
1526
%%     <dd><code>{atom(), [{atom(), Value}]}</code></dd>
 
1527
%%   <dt><code>record_access</code>:</dt>
 
1528
%%     <dd><code>{atom(), atom()} | atom()</code></dd>
 
1529
%%   <dt><code>record_index_expr</code>:</dt>
 
1530
%%     <dd><code>{atom(), atom()}</code></dd>
 
1531
%% </dl>
 
1532
%%
 
1533
%% <p>For a <code>record_expr</code> node, <code>Info</code> represents
 
1534
%% the record name and the list of descriptors for the involved fields,
 
1535
%% listed in the order they appear. (See
 
1536
%% <code>analyze_record_field/1</code> for details on the field
 
1537
%% descriptors). For a <code>record_access</code> node,
 
1538
%% <code>Info</code> represents the record name and the field name (or
 
1539
%% if the record name is not included, only the field name; this is
 
1540
%% allowed only in Mnemosyne-query syntax). For a
 
1541
%% <code>record_index_expr</code> node, <code>Info</code> represents the
 
1542
%% record name and the name field name.</p>
 
1543
%%
 
1544
%% <p>The evaluation throws <code>syntax_error</code> if
 
1545
%% <code>Node</code> represents a record expression that is not
 
1546
%% well-formed.</p>
 
1547
%%
 
1548
%% @see analyze_record_attribute/1
 
1549
%% @see analyze_record_field/1
 
1550
 
 
1551
analyze_record_expr(Node) ->
 
1552
    case erl_syntax:type(Node) of
 
1553
        record_expr ->
 
1554
            A = erl_syntax:record_expr_type(Node),
 
1555
            case erl_syntax:type(A) of
 
1556
                atom ->
 
1557
                    Fs = [analyze_record_field(F)
 
1558
                          || F <- erl_syntax:record_expr_fields(Node)],
 
1559
                    {record_expr, {erl_syntax:atom_value(A), Fs}};
 
1560
                _ ->
 
1561
                    throw(syntax_error)
 
1562
            end;
 
1563
        record_access ->
 
1564
            F = erl_syntax:record_access_field(Node),
 
1565
            case erl_syntax:type(F) of
 
1566
                atom ->
 
1567
                    case erl_syntax:record_access_type(Node) of
 
1568
                        none ->
 
1569
                            {record_access, erl_syntax:atom_value(F)};
 
1570
                        A ->
 
1571
                            case erl_syntax:type(A) of
 
1572
                                atom ->
 
1573
                                    {record_access,
 
1574
                                     {erl_syntax:atom_value(A),
 
1575
                                      erl_syntax:atom_value(F)}};
 
1576
                                _ ->
 
1577
                                    throw(syntax_error)
 
1578
                            end
 
1579
                    end;
 
1580
                _ ->
 
1581
                    throw(syntax_error)
 
1582
            end;
 
1583
        record_index_expr ->
 
1584
            F = erl_syntax:record_index_expr_field(Node),
 
1585
            case erl_syntax:type(F) of
 
1586
                atom ->
 
1587
                    A = erl_syntax:record_index_expr_type(Node),
 
1588
                    case erl_syntax:type(A) of
 
1589
                        atom ->
 
1590
                            {record_index_expr,
 
1591
                             {erl_syntax:atom_value(A),
 
1592
                              erl_syntax:atom_value(F)}};
 
1593
                        _ ->
 
1594
                            throw(syntax_error)
 
1595
                    end;
 
1596
                _ ->
 
1597
                    throw(syntax_error)
 
1598
            end;
 
1599
        Type ->
 
1600
            Type
 
1601
    end.
 
1602
 
 
1603
%% =====================================================================
 
1604
%% @spec analyze_record_field(Node::syntaxTree()) -> {atom(), Value}
 
1605
%%
 
1606
%%          Value = none | syntaxTree()
 
1607
%%
 
1608
%% @doc Returns the label and value-expression of a record field
 
1609
%% specifier. The result is a pair <code>{Label, Value}</code>, if
 
1610
%% <code>Node</code> represents "<code>Label = <em>Value</em></code>" or
 
1611
%% "<code>Label</code>", where in the first case, <code>Value</code> is
 
1612
%% a syntax tree, and in the second case <code>Value</code> is
 
1613
%% <code>none</code>.
 
1614
%%
 
1615
%% <p>The evaluation throws <code>syntax_error</code> if
 
1616
%% <code>Node</code> does not represent a well-formed record field
 
1617
%% specifier.</p>
 
1618
%%
 
1619
%% @see analyze_record_attribute/1
 
1620
%% @see analyze_record_expr/1
 
1621
 
 
1622
analyze_record_field(Node) ->
 
1623
    case erl_syntax:type(Node) of
 
1624
        record_field ->
 
1625
            A = erl_syntax:record_field_name(Node),
 
1626
            case erl_syntax:type(A) of
 
1627
                atom ->
 
1628
                    T = erl_syntax:record_field_value(Node),
 
1629
                    {erl_syntax:atom_value(A), T};
 
1630
                _ ->
 
1631
                    throw(syntax_error)
 
1632
            end;
 
1633
        _ ->
 
1634
            throw(syntax_error)
 
1635
    end.
 
1636
 
 
1637
 
 
1638
%% =====================================================================
 
1639
%% @spec analyze_file_attribute(Node::syntaxTree()) ->
 
1640
%%           {string(), integer()}
 
1641
%%
 
1642
%% @doc Returns the file name and line number of a <code>file</code>
 
1643
%% attribute. The result is the pair <code>{File, Line}</code> if
 
1644
%% <code>Node</code> represents "<code>-file(File, Line).</code>".
 
1645
%%
 
1646
%% <p>The evaluation throws <code>syntax_error</code> if
 
1647
%% <code>Node</code> does not represent a well-formed <code>file</code>
 
1648
%% attribute.</p>
 
1649
%%
 
1650
%% @see analyze_attribute/1
 
1651
 
 
1652
analyze_file_attribute(Node) ->
 
1653
    case erl_syntax:type(Node) of
 
1654
        attribute ->
 
1655
            case erl_syntax:attribute_arguments(Node) of
 
1656
                [F, N] ->
 
1657
                    case (erl_syntax:type(F) == string)
 
1658
                        and (erl_syntax:type(N) == integer) of
 
1659
                        true ->
 
1660
                            {erl_syntax:string_value(F),
 
1661
                             erl_syntax:integer_value(N)};
 
1662
                        false ->
 
1663
                            throw(syntax_error)
 
1664
                    end;
 
1665
                _ ->
 
1666
                    throw(syntax_error)
 
1667
            end;
 
1668
        _ ->
 
1669
            throw(syntax_error)
 
1670
    end.
 
1671
 
 
1672
 
 
1673
%% =====================================================================
 
1674
%% @spec analyze_function(Node::syntaxTree()) -> {atom(), integer()}
 
1675
%%
 
1676
%% @doc Returns the name and arity of a function definition. The result
 
1677
%% is a pair <code>{Name, A}</code> if <code>Node</code> represents a
 
1678
%% function definition "<code>Name(<em>P_1</em>, ..., <em>P_A</em>) ->
 
1679
%% ...</code>".
 
1680
%%
 
1681
%% <p>The evaluation throws <code>syntax_error</code> if
 
1682
%% <code>Node</code> does not represent a well-formed function
 
1683
%% definition.</p>
 
1684
%%
 
1685
%% @see analyze_rule/1
 
1686
 
 
1687
analyze_function(Node) ->
 
1688
    case erl_syntax:type(Node) of
 
1689
        function ->
 
1690
            N = erl_syntax:function_name(Node),
 
1691
            case erl_syntax:type(N) of
 
1692
                atom ->
 
1693
                    {erl_syntax:atom_value(N),
 
1694
                     erl_syntax:function_arity(Node)};
 
1695
                _ ->
 
1696
                    throw(syntax_error)
 
1697
            end;
 
1698
        _ ->
 
1699
            throw(syntax_error)
 
1700
    end.
 
1701
 
 
1702
 
 
1703
%% =====================================================================
 
1704
%% @spec analyze_rule(Node::syntaxTree()) -> {atom(), integer()}
 
1705
%%
 
1706
%% @doc Returns the name and arity of a Mnemosyne rule. The result is a
 
1707
%% pair <code>{Name, A}</code> if <code>Node</code> represents a rule
 
1708
%% "<code>Name(<em>P_1</em>, ..., <em>P_A</em>) :- ...</code>".
 
1709
%%
 
1710
%% <p>The evaluation throws <code>syntax_error</code> if
 
1711
%% <code>Node</code> does not represent a well-formed Mnemosyne
 
1712
%% rule.</p>
 
1713
%%
 
1714
%% @see analyze_function/1
 
1715
 
 
1716
analyze_rule(Node) ->
 
1717
    case erl_syntax:type(Node) of
 
1718
        rule ->
 
1719
            N = erl_syntax:rule_name(Node),
 
1720
            case erl_syntax:type(N) of
 
1721
                atom ->
 
1722
                    {erl_syntax:atom_value(N),
 
1723
                     erl_syntax:rule_arity(Node)};
 
1724
                _ ->
 
1725
                    throw(syntax_error)
 
1726
            end;
 
1727
        _ ->
 
1728
            throw(syntax_error)
 
1729
    end.
 
1730
 
 
1731
 
 
1732
%% =====================================================================
 
1733
%% @spec analyze_implicit_fun(Node::syntaxTree()) -> FunctionName
 
1734
%%
 
1735
%%          FunctionName = atom() | {atom(), integer()}
 
1736
%%                       | {ModuleName, FunctionName}
 
1737
%%          ModuleName = atom()
 
1738
%%      
 
1739
%% @doc Returns the name of an implicit fun expression "<code>fun
 
1740
%% <em>F</em></code>". The result is a representation of the function
 
1741
%% name <code>F</code>. (Cf. <code>analyze_function_name/1</code>.)
 
1742
%%
 
1743
%% <p>The evaluation throws <code>syntax_error</code> if
 
1744
%% <code>Node</code> does not represent a well-formed implicit fun.</p>
 
1745
%%
 
1746
%% @see analyze_function_name/1
 
1747
 
 
1748
analyze_implicit_fun(Node) ->
 
1749
    case erl_syntax:type(Node) of
 
1750
        implicit_fun ->
 
1751
            analyze_function_name(
 
1752
              erl_syntax:implicit_fun_name(Node));
 
1753
        _ ->
 
1754
            throw(syntax_error)
 
1755
    end.
 
1756
 
 
1757
 
 
1758
%% =====================================================================
 
1759
%% @spec analyze_application(Node::syntaxTree()) -> FunctionName | Arity
 
1760
%%
 
1761
%%          FunctionName = {atom(), Arity}
 
1762
%%                       | {ModuleName, FunctionName}
 
1763
%%          Arity = integer()
 
1764
%%          ModuleName = atom()
 
1765
%%
 
1766
%% @doc Returns the name of a called function. The result is a
 
1767
%% representation of the name of the applied function <code>F/A</code>,
 
1768
%% if <code>Node</code> represents a function application
 
1769
%% "<code><em>F</em>(<em>X_1</em>, ..., <em>X_A</em>)</code>". If the
 
1770
%% function is not explicitly named (i.e., <code>F</code> is given by
 
1771
%% some expression), only the arity <code>A</code> is returned.
 
1772
%%
 
1773
%% <p>The evaluation throws <code>syntax_error</code> if
 
1774
%% <code>Node</code> does not represent a well-formed application
 
1775
%% expression.</p>
 
1776
%%
 
1777
%% @see analyze_function_name/1
 
1778
 
 
1779
analyze_application(Node) ->
 
1780
    case erl_syntax:type(Node) of
 
1781
        application ->
 
1782
            A = length(erl_syntax:application_arguments(Node)),
 
1783
            F = erl_syntax:application_operator(Node),
 
1784
            case catch {ok, analyze_function_name(F)} of
 
1785
                syntax_error ->
 
1786
                    A;
 
1787
                {ok, N} ->
 
1788
                    append_arity(A, N);
 
1789
                _ ->
 
1790
                    throw(syntax_error)
 
1791
            end;
 
1792
        _ ->
 
1793
            throw(syntax_error)
 
1794
    end.
 
1795
 
 
1796
 
 
1797
%% =====================================================================
 
1798
%% @spec function_name_expansions(Names::[Name]) -> [{ShortName, Name}]
 
1799
%%
 
1800
%%          Name = ShortName | {atom(), Name}
 
1801
%%          ShortName = atom() | {atom(), integer()}
 
1802
%%
 
1803
%% @doc Creates a mapping from corresponding short names to full
 
1804
%% function names. Names are represented by nested tuples of atoms and
 
1805
%% integers (cf. <code>analyze_function_name/1</code>). The result is a
 
1806
%% list containing a pair <code>{ShortName, Name}</code> for each
 
1807
%% element <code>Name</code> in the given list, where the corresponding
 
1808
%% <code>ShortName</code> is the rightmost-innermost part of
 
1809
%% <code>Name</code>. The list thus represents a finite mapping from
 
1810
%% unqualified names to the corresponding qualified names.
 
1811
%%
 
1812
%% <p>Note: the resulting list can contain more than one tuple
 
1813
%% <code>{ShortName, Name}</code> for the same <code>ShortName</code>,
 
1814
%% possibly with different values for <code>Name</code>, depending on
 
1815
%% the given list.</p>
 
1816
%%
 
1817
%% @see analyze_function_name/1
 
1818
 
 
1819
function_name_expansions(Fs) ->
 
1820
    function_name_expansions(Fs, []).
 
1821
 
 
1822
function_name_expansions([F | Fs], Ack) ->
 
1823
    function_name_expansions(Fs,
 
1824
                             function_name_expansions(F, F, Ack));
 
1825
function_name_expansions([], Ack) ->
 
1826
    Ack.
 
1827
 
 
1828
function_name_expansions({A, N}, Name, Ack) when integer(N) ->
 
1829
    [{{A, N}, Name} | Ack];
 
1830
function_name_expansions({_, N}, Name, Ack) ->
 
1831
    function_name_expansions(N, Name,  Ack);
 
1832
function_name_expansions(A, Name, Ack) ->
 
1833
    [{A, Name} | Ack].
 
1834
 
 
1835
 
 
1836
%% =====================================================================
 
1837
%% @spec strip_comments(Tree::syntaxTree()) -> syntaxTree()
 
1838
%%
 
1839
%% @doc Removes all comments from all nodes of a syntax tree. All other
 
1840
%% attributes (such as position information) remain unchanged.
 
1841
%% Standalone comments in form lists are removed; any other standalone
 
1842
%% comments are changed into null-comments (no text, no indentation).
 
1843
 
 
1844
strip_comments(Tree) ->
 
1845
    map(fun strip_comments_1/1, Tree).
 
1846
 
 
1847
strip_comments_1(T) ->
 
1848
    case erl_syntax:type(T) of
 
1849
        form_list ->
 
1850
            Es = erl_syntax:form_list_elements(T),
 
1851
            Es1 = [E || E <- Es, erl_syntax:type(E) /= comment],
 
1852
            T1 = erl_syntax:copy_attrs(T, erl_syntax:form_list(Es1)),
 
1853
            erl_syntax:remove_comments(T1);
 
1854
        comment ->
 
1855
            erl_syntax:comment([]);
 
1856
        _ ->
 
1857
            erl_syntax:remove_comments(T)
 
1858
    end.
 
1859
 
 
1860
%% =====================================================================
 
1861
%% @spec to_comment(Tree) -> syntaxTree()
 
1862
%% @equiv to_comment(Tree, "% ")
 
1863
 
 
1864
to_comment(Tree) ->
 
1865
    to_comment(Tree, "% ").
 
1866
 
 
1867
%% =====================================================================
 
1868
%% @spec to_comment(Tree::syntaxTree(), Prefix::string()) ->
 
1869
%%           syntaxTree()
 
1870
%%
 
1871
%% @doc Equivalent to <code>to_comment(Tree, Prefix, F)</code> for a
 
1872
%% default formatting function <code>F</code>. The default
 
1873
%% <code>F</code> simply calls <code>erl_prettypr:format/1</code>.
 
1874
%%
 
1875
%% @see to_comment/3
 
1876
%% @see erl_prettypr:format/1
 
1877
 
 
1878
to_comment(Tree, Prefix) ->
 
1879
    F = fun (T) -> erl_prettypr:format(T) end,
 
1880
    to_comment(Tree, Prefix, F).
 
1881
 
 
1882
%% =====================================================================
 
1883
%% @spec to_comment(Tree::syntaxTree(), Prefix::string(), Printer) ->
 
1884
%%           syntaxTree()
 
1885
%%
 
1886
%%          Printer = (syntaxTree()) -> string()
 
1887
%%
 
1888
%% @doc Transforms a syntax tree into an abstract comment. The lines of
 
1889
%% the comment contain the text for <code>Node</code>, as produced by
 
1890
%% the given <code>Printer</code> function. Each line of the comment is
 
1891
%% prefixed by the string <code>Prefix</code> (this does not include the
 
1892
%% initial "<code>%</code>" character of the comment line).
 
1893
%%
 
1894
%% <p>For example, the result of
 
1895
%% <code>to_comment(erl_syntax:abstract([a,b,c]))</code> represents
 
1896
%% <pre>
 
1897
%%         %% [a,b,c]</pre>
 
1898
%% (cf. <code>to_comment/1</code>).</p>
 
1899
%%
 
1900
%% <p>Note: the text returned by the formatting function will be split
 
1901
%% automatically into separate comment lines at each line break. No
 
1902
%% extra work is needed.</p>
 
1903
%%
 
1904
%% @see to_comment/1
 
1905
%% @see to_comment/2
 
1906
 
 
1907
to_comment(Tree, Prefix, F) ->
 
1908
    erl_syntax:comment(split_lines(F(Tree), Prefix)).
 
1909
 
 
1910
 
 
1911
%% =====================================================================
 
1912
%% @spec limit(Tree, Depth) -> syntaxTree()
 
1913
%%
 
1914
%% @doc Equivalent to <code>limit(Tree, Depth, Text)</code> using the
 
1915
%% text <code>"..."</code> as default replacement.
 
1916
%%
 
1917
%% @see limit/3
 
1918
%% @see erl_syntax:text/1
 
1919
 
 
1920
limit(Tree, Depth) ->
 
1921
    limit(Tree, Depth, erl_syntax:text("...")).
 
1922
 
 
1923
%% =====================================================================
 
1924
%% @spec limit(Tree::syntaxTree(), Depth::integer(),
 
1925
%%             Node::syntaxTree()) -> syntaxTree()
 
1926
%%
 
1927
%% @doc Limits a syntax tree to a specified depth. Replaces all non-leaf
 
1928
%% subtrees in <code>Tree</code> at the given <code>Depth</code> by
 
1929
%% <code>Node</code>. If <code>Depth</code> is negative, the result is
 
1930
%% always <code>Node</code>, even if <code>Tree</code> has no subtrees.
 
1931
%%
 
1932
%% <p>When a group of subtrees (as e.g., the argument list of an
 
1933
%% <code>application</code> node) is at the specified depth, and there
 
1934
%% are two or more subtrees in the group, these will be collectively
 
1935
%% replaced by <code>Node</code> even if they are leaf nodes. Groups of
 
1936
%% subtrees that are above the specified depth will be limited in size,
 
1937
%% as if each subsequent tree in the group were one level deeper than
 
1938
%% the previous. E.g., if <code>Tree</code> represents a list of
 
1939
%% integers "<code>[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]</code>", the result
 
1940
%% of <code>limit(Tree, 5)</code> will represent <code>[1, 2, 3, 4,
 
1941
%% ...]</code>.</p>
 
1942
%%
 
1943
%% <p>The resulting syntax tree is typically only useful for
 
1944
%% pretty-printing or similar visual formatting.</p>
 
1945
%%
 
1946
%% @see limit/2
 
1947
 
 
1948
limit(_Tree, Depth, Node) when Depth < 0 ->
 
1949
    Node;
 
1950
limit(Tree, Depth, Node) ->
 
1951
    limit_1(Tree, Depth, Node).
 
1952
 
 
1953
limit_1(Tree, Depth, Node) ->
 
1954
    %% Depth is nonnegative here.
 
1955
    case erl_syntax:subtrees(Tree) of
 
1956
        [] ->
 
1957
            if Depth > 0 ->
 
1958
                    Tree;
 
1959
               true ->
 
1960
                    case is_simple_leaf(Tree) of
 
1961
                        true ->
 
1962
                            Tree;
 
1963
                        false ->
 
1964
                            Node
 
1965
                    end
 
1966
            end;
 
1967
        Gs ->
 
1968
            if Depth > 1 ->
 
1969
                    Gs1 = [[limit_1(T, Depth - 1, Node)
 
1970
                            || T <- limit_list(G, Depth, Node)]
 
1971
                           || G <- Gs],
 
1972
                    rewrite(Tree,
 
1973
                            erl_syntax:make_tree(erl_syntax:type(Tree),
 
1974
                                                 Gs1));
 
1975
               Depth == 0 ->
 
1976
                    %% Depth is zero, and this is not a leaf node
 
1977
                    %% so we always replace it.
 
1978
                    Node;
 
1979
               true ->
 
1980
                    %% Depth is 1, so all subtrees are to be cut.
 
1981
                    %% This is done groupwise.
 
1982
                    Gs1 = [cut_group(G, Node) || G <- Gs],
 
1983
                    rewrite(Tree,
 
1984
                            erl_syntax:make_tree(erl_syntax:type(Tree),
 
1985
                                                 Gs1))
 
1986
            end
 
1987
    end.
 
1988
 
 
1989
cut_group([], _Node) ->
 
1990
    [];
 
1991
cut_group([T], Node) ->
 
1992
    %% Only if the group contains a single subtree do we try to
 
1993
    %% preserve it if suitable.
 
1994
    [limit_1(T, 0, Node)];
 
1995
cut_group(_Ts, Node) ->
 
1996
    [Node].
 
1997
 
 
1998
is_simple_leaf(Tree) ->
 
1999
    case erl_syntax:type(Tree) of
 
2000
        atom -> true;
 
2001
        char -> true;
 
2002
        float -> true;
 
2003
        integer -> true;
 
2004
        nil -> true;
 
2005
        operator -> true;
 
2006
        tuple -> true;
 
2007
        underscore -> true;
 
2008
        variable -> true;
 
2009
        _ -> false
 
2010
    end.
 
2011
 
 
2012
%% If list has more than N elements, take the N - 1 first and
 
2013
%% append Node; otherwise return list as is.
 
2014
 
 
2015
limit_list(Ts, N, Node) ->
 
2016
    if length(Ts) > N ->
 
2017
            limit_list_1(Ts, N - 1, Node);
 
2018
       true ->
 
2019
            Ts
 
2020
    end.
 
2021
 
 
2022
limit_list_1([T | Ts], N, Node) ->
 
2023
    if N > 0 ->
 
2024
            [T | limit_list_1(Ts, N - 1, Node)];
 
2025
       true ->
 
2026
            [Node]
 
2027
    end;
 
2028
limit_list_1([], _N, _Node) ->
 
2029
    [].
 
2030
 
 
2031
 
 
2032
%% =====================================================================
 
2033
%% Utility functions
 
2034
 
 
2035
rewrite(Tree, Tree1) ->
 
2036
    erl_syntax:copy_attrs(Tree, Tree1).
 
2037
 
 
2038
module_name_to_atom(M) ->
 
2039
    case erl_syntax:type(M) of
 
2040
        atom ->
 
2041
            erl_syntax:atom_value(M);
 
2042
        qualified_name ->
 
2043
            list_to_atom(packages:concat(
 
2044
                           [erl_syntax:atom_value(A)
 
2045
                            || A <- erl_syntax:qualified_name_segments(M)])
 
2046
                        );
 
2047
        _ ->
 
2048
            throw(syntax_error)
 
2049
    end.
 
2050
 
 
2051
%% This splits lines at line terminators and expands tab characters to
 
2052
%% spaces. The width of a tab is assumed to be 8.
 
2053
 
 
2054
% split_lines(Cs) ->
 
2055
%     split_lines(Cs, "").
 
2056
 
 
2057
split_lines(Cs, Prefix) ->
 
2058
    split_lines(Cs, Prefix, 0).
 
2059
 
 
2060
split_lines(Cs, Prefix, N) ->
 
2061
    lists:reverse(split_lines(Cs, N, [], [], Prefix)).
 
2062
 
 
2063
split_lines([$\r, $\n | Cs], _N, Cs1, Ls, Prefix) ->
 
2064
    split_lines_1(Cs, Cs1, Ls, Prefix);
 
2065
split_lines([$\r | Cs], _N, Cs1, Ls, Prefix) ->
 
2066
    split_lines_1(Cs, Cs1, Ls, Prefix);
 
2067
split_lines([$\n | Cs], _N, Cs1, Ls, Prefix) ->
 
2068
    split_lines_1(Cs, Cs1, Ls, Prefix);
 
2069
split_lines([$\t | Cs], N, Cs1, Ls, Prefix) ->
 
2070
    split_lines(Cs, 0, push(8 - (N rem 8), $\040, Cs1), Ls,
 
2071
                Prefix);
 
2072
split_lines([C | Cs], N, Cs1, Ls, Prefix) ->
 
2073
    split_lines(Cs, N + 1, [C | Cs1], Ls, Prefix);
 
2074
split_lines([], _, [], Ls, _) ->
 
2075
    Ls;
 
2076
split_lines([], _N, Cs, Ls, Prefix) ->
 
2077
    [Prefix ++ lists:reverse(Cs) | Ls].
 
2078
 
 
2079
split_lines_1(Cs, Cs1, Ls, Prefix) ->
 
2080
    split_lines(Cs, 0, [], [Prefix ++ lists:reverse(Cs1) | Ls],
 
2081
                Prefix).
 
2082
 
 
2083
push(N, C, Cs) when N > 0 ->
 
2084
    push(N - 1, C, [C | Cs]);
 
2085
push(0, _, Cs) ->
 
2086
    Cs.
 
2087