← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lib/dialyzer/src/dialyzer_dep.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:
lib/dialyzer/src/dialyzer_dep.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
%% Copyright 2006, Tobias Lindahl and Kostis Sagonas
 
13
%% 
 
14
%%     $Id$
 
15
%%
 
16
 
 
17
%%%-------------------------------------------------------------------
 
18
%%% File    : dialyzer_dep.erl
 
19
%%% Author  : Tobias Lindahl <tobiasl@it.uu.se>
 
20
%%%
 
21
%%% Description: A pretty limited but efficient escape/dependency
 
22
%%%              analysis of Core Erlang.
 
23
%%%
 
24
%%% Created : 28 Oct 2005 by Tobias Lindahl <tobiasl@it.uu.se>
 
25
%%%-------------------------------------------------------------------
 
26
-module(dialyzer_dep).
 
27
 
 
28
-define(NO_UNUSED, true).
 
29
 
 
30
-export([analyze/1]).
 
31
-ifndef(NO_UNUSED).
 
32
-export([test/1]).
 
33
-endif.
 
34
 
 
35
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
36
%%
 
37
%% analyze(CoreTree) -> {Deps, Esc, Calls}.
 
38
%%                
 
39
%% Deps =  a dict mapping labels of functions to a ordset of functions it calls.
 
40
%%
 
41
%% Esc =   a set (ordsets) of the labels of escaping functions. A function
 
42
%%         is considered to escape if the control escapes a function,
 
43
%%         i.e., this analysis is not module-local but rather
 
44
%%         function-local.
 
45
%%
 
46
%% Calls = a dict mapping apply:s to a ordset of function labels to which
 
47
%%         the operation can refer to. If 'external' is part of the
 
48
%%         set the operation can be externally defined.
 
49
%%
 
50
 
 
51
analyze(Tree) ->
 
52
  %%io:format("Handling ~w\n", [cerl:atom_val(cerl:module_name(Tree))]),
 
53
  {_, State} = traverse(Tree, map__new(), state__new(Tree), top),
 
54
  Esc = state__esc(State), 
 
55
  %% Add dependency from 'external' to all escaping function
 
56
  State1 = state__add_deps(external, output(Esc), State),
 
57
  Deps = state__deps(State1),
 
58
  Calls = state__calls(State1),
 
59
  {map__finalize(Deps), set__to_ordsets(Esc), map__finalize(Calls)}.
 
60
 
 
61
traverse(Tree, Out, State, CurrentFun) ->
 
62
  %%io:format("Type: ~w\n", [cerl:type(Tree)]),
 
63
  case cerl:type(Tree) of
 
64
    apply ->
 
65
      Op = cerl:apply_op(Tree),
 
66
      Args = cerl:apply_args(Tree),
 
67
      %% Op is always a variable and should not be marked as escaping
 
68
      %% based on its use.
 
69
      case var =:= cerl:type(Op) of
 
70
        false -> erlang:fault({apply_op_not_a_variable, cerl:type(Op)});
 
71
        true -> ok
 
72
      end,
 
73
      OpFuns = case map__lookup(cerl_trees:get_label(Op), Out) of
 
74
                 none -> output(none);
 
75
                 {value, OF} -> OF
 
76
               end,
 
77
      {ArgFuns, State2} = traverse_list(Args, Out, State, CurrentFun),
 
78
      State3 = state__add_esc(merge_outs(ArgFuns), State2),
 
79
      State4 = state__add_deps(CurrentFun, OpFuns, State3),
 
80
      State5 = state__store_callsite(cerl_trees:get_label(Tree), OpFuns,State4),
 
81
      {output(set__singleton(external)), State5};
 
82
    binary ->
 
83
      {output(none), State};
 
84
    'case' ->
 
85
      Arg = cerl:case_arg(Tree),
 
86
      {Funs, NewState} = traverse(Arg, Out, State, CurrentFun),
 
87
      Clauses = cerl:case_clauses(Tree),
 
88
      traverse_clauses(Clauses, Funs, Out, NewState, CurrentFun);
 
89
    call ->
 
90
      Args = cerl:call_args(Tree),
 
91
      {ArgFuns, State1} = traverse_list(Args, Out, State, CurrentFun),
 
92
      remote_call(Tree, merge_outs(ArgFuns), State1);
 
93
    'catch' ->
 
94
      traverse(cerl:catch_body(Tree), Out, State, CurrentFun);
 
95
    cons ->
 
96
      {HdFuns, State1} = traverse(cerl:cons_hd(Tree), Out, State, CurrentFun),
 
97
      {TlFuns, State2} = traverse(cerl:cons_tl(Tree), Out, State1, CurrentFun),
 
98
      {merge_outs([HdFuns, TlFuns]), State2};
 
99
    'fun' ->
 
100
      %%io:format("Entering fun: ~w\n", [cerl_trees:get_label(Tree)]),
 
101
      Body = cerl:fun_body(Tree),
 
102
      Label = cerl_trees:get_label(Tree),
 
103
      if CurrentFun =:= top -> 
 
104
          State1 = state__add_deps(top, output(set__singleton(Label)), State);
 
105
         true -> 
 
106
          O1 = output(set__singleton(CurrentFun)),
 
107
          O2 = output(set__singleton(Label)),
 
108
          TmpState = state__add_deps(Label, O1, State),
 
109
          State1 = state__add_deps(CurrentFun, O2,TmpState)
 
110
      end,
 
111
      {BodyFuns, State2} = traverse(Body, Out, State1, 
 
112
                                    cerl_trees:get_label(Tree)),
 
113
      {output(set__singleton(Label)), state__add_esc(BodyFuns, State2)};
 
114
    'let' ->
 
115
      Vars = cerl:let_vars(Tree),
 
116
      Arg = cerl:let_arg(Tree),
 
117
      Body = cerl:let_body(Tree),
 
118
      {ArgFuns, State1} = traverse(Arg, Out, State, CurrentFun),
 
119
      Out1 = bind_list(Vars, ArgFuns, Out),
 
120
      traverse(Body, Out1, State1, CurrentFun);
 
121
    letrec ->
 
122
      Defs = cerl:letrec_defs(Tree),
 
123
      Body = cerl:letrec_body(Tree),
 
124
      Out1 = bind_defs(Defs, Out),
 
125
      State1 = traverse_defs(Defs, Out1, State, CurrentFun),
 
126
      traverse(Body, Out1, State1, CurrentFun);
 
127
    literal ->
 
128
      {output(none), State};
 
129
    module ->
 
130
      Defs = cerl:module_defs(Tree),
 
131
      Out1 = bind_defs(Defs, Out),
 
132
      State1 = traverse_defs(Defs, Out1, State, CurrentFun),
 
133
      {output(none), State1};
 
134
    primop ->
 
135
      Args = cerl:primop_args(Tree),
 
136
      {ArgFuns, State1} = traverse_list(Args, Out, State, CurrentFun),
 
137
      primop(Tree, merge_outs(ArgFuns), State1);
 
138
    'receive' ->
 
139
      Clauses = cerl:receive_clauses(Tree),
 
140
      TimeOut = cerl:receive_timeout(Tree),
 
141
      Action = cerl:receive_action(Tree),
 
142
      {ClauseFuns, State1} = 
 
143
        traverse_clauses(Clauses, output(none), Out, State, CurrentFun),
 
144
      {_, State2} = traverse(TimeOut, Out, State1, CurrentFun),
 
145
      {ActionFuns, State3} = traverse(Action, Out, State2, CurrentFun),
 
146
      {merge_outs([ClauseFuns, ActionFuns]), State3};
 
147
    seq ->
 
148
      {_, State1} = traverse(cerl:seq_arg(Tree), Out, State, CurrentFun),
 
149
      traverse(cerl:seq_body(Tree), Out, State1, CurrentFun);
 
150
    'try' ->
 
151
      Arg = cerl:try_arg(Tree),
 
152
      Body = cerl:try_body(Tree),
 
153
      Vars = cerl:try_vars(Tree),
 
154
      EVars = cerl:try_evars(Tree),
 
155
      Handler = cerl:try_handler(Tree),
 
156
      {ArgFuns, State1} = traverse(Arg, Out, State, CurrentFun),
 
157
      Out1 = bind_list(Vars, ArgFuns, Out),
 
158
      {BodyFuns, State2} = traverse(Body, Out1, State1, CurrentFun),
 
159
      Out2 = bind_single(EVars, output(set__singleton(external)), Out),
 
160
      {HandlerFuns, State3} = traverse(Handler, Out2, State2, CurrentFun),
 
161
      {merge_outs([BodyFuns, HandlerFuns]), State3};
 
162
    tuple ->
 
163
      Args = cerl:tuple_es(Tree),
 
164
      {List, State1} = traverse_list(Args, Out, State, CurrentFun),
 
165
      {merge_outs(List), State1};
 
166
    values ->      
 
167
      traverse_list(cerl:values_es(Tree), Out, State, CurrentFun);
 
168
    var ->
 
169
      case map__lookup(cerl_trees:get_label(Tree), Out) of
 
170
        none -> {output(none), State};
 
171
        {value, Val} -> 
 
172
          case is_only_external(Val) of
 
173
            true ->
 
174
              %% Do nothing
 
175
              {Val, State};
 
176
            false ->
 
177
              %% If this is used in a function this means a dependency.
 
178
              {Val, state__add_deps(CurrentFun, Val, State)}
 
179
          end
 
180
      end
 
181
  end.
 
182
 
 
183
traverse_list(Trees, Out, State, CurrentFun) ->
 
184
  traverse_list(Trees, Out, State, CurrentFun, []).
 
185
 
 
186
traverse_list([Tree|Left], Out, State, CurrentFun, Acc) ->
 
187
  {X, State1} = traverse(Tree, Out, State, CurrentFun),
 
188
  traverse_list(Left, Out, State1, CurrentFun, [X|Acc]);
 
189
traverse_list([], _Out, State, _CurrentFun, Acc) ->
 
190
  {output(lists:reverse(Acc)), State}.
 
191
 
 
192
traverse_defs([{_, Fun}|Left], Out, State, CurrentFun) ->
 
193
  {_, State1} = traverse(Fun, Out, State, CurrentFun),
 
194
  traverse_defs(Left, Out, State1, CurrentFun);
 
195
traverse_defs([], _Out, State, _CurrentFun) ->
 
196
  State.
 
197
 
 
198
traverse_clauses(Clauses, ArgFuns, Out, State, CurrentFun) ->
 
199
  case filter_match_fail(Clauses) of
 
200
    [] ->
 
201
      %% Can happen for example with receives used as timouts.
 
202
      {output(none), State};
 
203
    Clauses1 ->
 
204
      traverse_clauses(Clauses1, ArgFuns, Out, State, CurrentFun, [])
 
205
  end.
 
206
 
 
207
traverse_clauses([Clause|Left], ArgFuns, Out, State, CurrentFun, Acc) ->
 
208
  Pats = cerl:clause_pats(Clause),
 
209
  Guard = cerl:clause_guard(Clause),
 
210
  Body = cerl:clause_body(Clause),
 
211
  Out1 = bind_pats_list(Pats, ArgFuns, Out),
 
212
  {_, State2} = traverse(Guard, Out1, State, CurrentFun),
 
213
  {BodyFuns, State3} = traverse(Body, Out1, State2, CurrentFun),
 
214
  traverse_clauses(Left, ArgFuns, Out, State3, CurrentFun, [BodyFuns|Acc]);
 
215
traverse_clauses([], _ArgFuns, _Out, State, _CurrentFun, Acc) ->
 
216
  {merge_outs(Acc), State}.
 
217
 
 
218
filter_match_fail([Clause]) ->
 
219
  Body = cerl:clause_body(Clause),
 
220
  case cerl:type(Body) of
 
221
    primop ->
 
222
      case cerl:atom_val(cerl:primop_name(Body)) of
 
223
        match_fail -> [];
 
224
        raise -> [];
 
225
        _ -> [Clause]
 
226
      end;
 
227
    _ -> [Clause]
 
228
  end;
 
229
filter_match_fail([H|T]) ->
 
230
  [H|filter_match_fail(T)];
 
231
filter_match_fail([]) ->
 
232
  %% This can actually happen, for example in 
 
233
  %%      receive after 1 -> ok end
 
234
  [].
 
235
 
 
236
remote_call(Tree, ArgFuns, State) ->  
 
237
  M = cerl:call_module(Tree),
 
238
  F = cerl:call_name(Tree),
 
239
  A = length(cerl:call_args(Tree)),
 
240
  case cerl:is_c_atom(M) andalso cerl:is_c_atom(F) of
 
241
    false ->
 
242
      %% Unknown function. 
 
243
      {output(set__singleton(external)), state__add_esc(ArgFuns, State)};
 
244
    true ->
 
245
      M1 = cerl:atom_val(M),
 
246
      F1 = cerl:atom_val(F),
 
247
      Literal = cerl_closurean:is_literal_op(M1, F1, A),
 
248
      case erl_bifs:is_pure(M1, F1, A) of
 
249
        true ->
 
250
          case Literal of
 
251
            true -> 
 
252
              {output(none), State};
 
253
            false -> 
 
254
              {output(set__singleton(external)), state__add_esc(ArgFuns, State)}
 
255
          end;
 
256
        false ->          
 
257
          State1 = case cerl_closurean:is_escape_op(M1, F1, A) of
 
258
                     true -> state__add_esc(ArgFuns, State);
 
259
                     false -> State
 
260
                   end,
 
261
          case Literal of
 
262
            true -> {output(none), State1};
 
263
            false -> {add_external(ArgFuns), State1}
 
264
          end
 
265
      end
 
266
  end.
 
267
 
 
268
primop(Tree, ArgFuns, State) ->
 
269
  F = cerl:atom_val(cerl:primop_name(Tree)),
 
270
  A = length(cerl:primop_args(Tree)),
 
271
  State1 = case cerl_closurean:is_escape_op(F, A) of
 
272
             true -> state__add_esc(ArgFuns, State);
 
273
             false -> State
 
274
           end,
 
275
  case cerl_closurean:is_literal_op(F, A) of
 
276
    true -> {output(none), State1};
 
277
    false -> {ArgFuns, State1}
 
278
  end.
 
279
 
 
280
%%____________________________________________________________
 
281
%%
 
282
%% Set
 
283
%%
 
284
 
 
285
-record(set, {set}).
 
286
 
 
287
set__singleton(Val) ->
 
288
  #set{set=sets:add_element(Val, sets:new())}.
 
289
 
 
290
set__from_list(List) ->
 
291
  #set{set=sets:from_list(List)}.
 
292
 
 
293
set__is_element(_El, none) ->
 
294
  false;
 
295
set__is_element(El, #set{set=Set}) ->
 
296
  sets:is_element(El, Set).
 
297
 
 
298
set__union(none, X) -> X;
 
299
set__union(X, none) -> X;
 
300
set__union(#set{set=X}, #set{set=Y}) -> #set{set=sets:union(X, Y)}.
 
301
 
 
302
set__to_ordsets(none) -> [];
 
303
set__to_ordsets(#set{set=Set}) -> ordsets:from_list(sets:to_list(Set)).
 
304
 
 
305
set__size(none) -> 0;
 
306
set__size(#set{set=X}) -> sets:size(X).
 
307
 
 
308
%%____________________________________________________________
 
309
%%
 
310
%% Outputs
 
311
%%
 
312
 
 
313
%% #output{type = single|list, 
 
314
%%         content = #set{} | [#output{}] | none}
 
315
 
 
316
-record(output, {type, content}).
 
317
 
 
318
output(none) -> #output{type=single, content=none};
 
319
output(S = #set{}) -> #output{type=single, content=S};
 
320
output(List) when is_list(List) -> #output{type=list, content=List}.
 
321
 
 
322
merge_outs([H|T]) ->
 
323
  merge_outs(T, H);
 
324
merge_outs(#output{type=list, content=[H|T]}) ->
 
325
  merge_outs(T, H);
 
326
merge_outs(#output{type=list, content=[]}) ->
 
327
  output(none).
 
328
 
 
329
merge_outs([#output{content=none}|Left], O) ->
 
330
  merge_outs(Left, O);
 
331
merge_outs([O|Left], #output{content=none}) ->
 
332
  merge_outs(Left, O);
 
333
merge_outs([#output{type=single, content=S1}|Left], 
 
334
           #output{type=single, content=S2}) ->
 
335
  merge_outs(Left, output(set__union(S1, S2)));
 
336
merge_outs([#output{type=list, content=L1}|Left],
 
337
           #output{type=list, content=L2}) ->
 
338
  NewList = [merge_outs([X, Y]) || {X, Y} <- lists:zip(L1, L2)],
 
339
  merge_outs(Left, output(NewList));
 
340
merge_outs([], Res) ->
 
341
  Res.
 
342
 
 
343
add_external(#output{type=single, content=Set}) ->
 
344
  output(set__union(Set, set__singleton(external)));
 
345
add_external(#output{type=list, content=List}) ->
 
346
  output([add_external(O) || O <- List]).
 
347
 
 
348
is_only_external(#output{type=single, content=Set}) ->
 
349
  set__is_element(external, Set) andalso (set__size(Set) =:= 1).
 
350
 
 
351
%%____________________________________________________________
 
352
%%
 
353
%% Map
 
354
%%
 
355
 
 
356
map__new() ->
 
357
  dict:new().
 
358
 
 
359
map__add(_Label, none, Map) ->
 
360
  Map;
 
361
map__add(Label, Set, Map) ->
 
362
  case map__lookup(Label, Map) of
 
363
    {value, OldSet} ->
 
364
      NewSet = set__union(OldSet, Set),
 
365
      map__store(Label, NewSet, Map);
 
366
    none ->
 
367
      map__store(Label, Set, Map)
 
368
  end.
 
369
 
 
370
map__store(Label, Val, Map) ->  
 
371
  dict:store(Label, Val, Map).
 
372
 
 
373
map__lookup(Label, Map) ->
 
374
  case dict:find(Label, Map) of
 
375
    {ok, Val} -> {value, Val};
 
376
    error -> none
 
377
  end.
 
378
 
 
379
map__finalize(Map) ->
 
380
  dict:map(fun(_Key, Set = #set{}) -> set__to_ordsets(Set);
 
381
              (_Key, #output{type=single, content=Set}) -> set__to_ordsets(Set)
 
382
           end, Map).
 
383
 
 
384
%%____________________________________________________________
 
385
%%
 
386
%% Binding outs in the map
 
387
%%
 
388
 
 
389
bind_pats_list(_Pats, #output{content=none}, Map) ->
 
390
  Map;
 
391
bind_pats_list([Pat], O = #output{type=single}, Map) ->
 
392
  bind_single(all_vars(Pat), O, Map);
 
393
bind_pats_list(Pats, #output{type=list, content=List}, Map) ->
 
394
  bind_pats_list(Pats, List, Map);
 
395
bind_pats_list([Pat|PatLeft],
 
396
               [O = #output{type=single}|SetLeft], Map)->
 
397
  Map1 = bind_single(all_vars(Pat), O, Map),
 
398
  bind_pats_list(PatLeft, SetLeft, Map1);
 
399
bind_pats_list([Pat|PatLeft],
 
400
               [#output{type=list, content=List}|SetLeft], Map)->
 
401
  case cerl:is_c_values(Pat) of
 
402
    true -> Map1 = bind_pats_list(cerl:values_es(Pat), List, Map);
 
403
    false -> Map1 = bind_single(all_vars(Pat), merge_outs(List), Map)
 
404
  end,
 
405
  bind_pats_list(PatLeft, SetLeft, Map1);
 
406
bind_pats_list([], [], Map) ->
 
407
  Map.
 
408
  
 
409
bind_single([Var|Left], O, Map) ->
 
410
  bind_single(Left, O, map__store(cerl_trees:get_label(Var), O, Map));
 
411
bind_single([], _O, Map) ->
 
412
  Map.
 
413
 
 
414
bind_list(List, O = #output{type=single}, Map) ->
 
415
  bind_single(List, O, Map);
 
416
bind_list(List1, #output{type=list, content=List2}, Map) ->
 
417
  bind_list1(List1, List2, Map).
 
418
 
 
419
bind_list1([Var|VarLeft], [O|OLeft], Map) ->
 
420
  bind_list1(VarLeft, OLeft, map__store(cerl_trees:get_label(Var), O, Map));
 
421
bind_list1([], [], Map) ->
 
422
  Map.
 
423
 
 
424
bind_defs([{Var, Fun}|Left], Map) ->
 
425
  O = output(set__singleton(cerl_trees:get_label(Fun))),
 
426
  Map1 = map__store(cerl_trees:get_label(Var), O, Map),
 
427
  bind_defs(Left, Map1);
 
428
bind_defs([], Map) ->
 
429
  Map.
 
430
 
 
431
all_vars(Tree) ->
 
432
  all_vars(Tree, []).
 
433
 
 
434
all_vars(Tree, AccIn) ->
 
435
  cerl_trees:fold(fun(SubTree, Acc) ->
 
436
                      case cerl:is_c_var(SubTree) of
 
437
                        true -> [SubTree|Acc];
 
438
                        false -> Acc
 
439
                      end
 
440
                  end, AccIn, Tree).
 
441
 
 
442
%%____________________________________________________________
 
443
%%
 
444
%% The state
 
445
 
 
446
-record(state, {deps, esc, call}).
 
447
 
 
448
state__new(Tree) ->
 
449
  Exports = set__from_list([X || X <- cerl:module_exports(Tree)]),
 
450
  InitEsc = set__from_list([cerl_trees:get_label(Fun) 
 
451
                            || {Var, Fun} <- cerl:module_defs(Tree),
 
452
                               set__is_element(Var, Exports)]),
 
453
  #state{deps=map__new(), esc=InitEsc, call=map__new()}.
 
454
 
 
455
state__add_deps(_From, #output{content=none}, State) ->
 
456
  State;
 
457
state__add_deps(From, #output{type=single, content=To}, 
 
458
                State = #state{deps=Map}) ->
 
459
  %%io:format("Adding deps from ~w to ~w\n", [From, set__to_ordsets(To)]),
 
460
  State#state{deps=map__add(From, To, Map)}.
 
461
 
 
462
state__deps(#state{deps=Deps}) ->
 
463
  Deps.
 
464
 
 
465
state__add_esc(#output{content=none}, State) ->
 
466
  State;
 
467
state__add_esc(#output{type=single, content=Set}, State = #state{esc=Esc}) ->
 
468
  State#state{esc=set__union(Set, Esc)}.
 
469
 
 
470
state__esc(#state{esc=Esc}) ->
 
471
  Esc.
 
472
 
 
473
state__store_callsite(_From, #output{content=none}, State) ->
 
474
  State;
 
475
state__store_callsite(From, To, State = #state{call=Calls}) ->
 
476
  State#state{call=map__store(From, To, Calls)}.
 
477
 
 
478
state__calls(#state{call=Calls}) ->
 
479
  Calls.
 
480
 
 
481
%%____________________________________________________________
 
482
%%
 
483
%% A test function. Not part of the intended interface.
 
484
%%
 
485
 
 
486
-ifndef(NO_UNUSED).
 
487
 
 
488
test(Mod) ->
 
489
  {ok, _, Code} = compile:file(Mod, [to_core,binary]), 
 
490
  Tree = cerl:from_records(Code),
 
491
  {LabeledTree, _} = cerl_trees:label(Tree),
 
492
 
 
493
  %%io:put_chars(cerl_prettypr:format(LabeledTree)),
 
494
  %%io:nl(),
 
495
 
 
496
  {Deps, Esc, Calls} = analyze(LabeledTree),
 
497
  Edges0 = dict:fold(fun(Caller, Set, Acc) ->
 
498
                         [[{Caller, Callee} || Callee <- Set]|Acc]
 
499
                     end, [], Deps),
 
500
  Edges1 = lists:flatten(Edges0),
 
501
  Edges = [{X,Y} || {X,Y} <- Edges1, X =/= top],
 
502
  Fun = fun(SubTree, Acc) ->
 
503
            case cerl:type(SubTree) of
 
504
              'fun' ->
 
505
                case lists:keysearch(id, 1, cerl:get_ann(SubTree)) of
 
506
                  false -> Acc;
 
507
                  {value, {id, ID}} -> 
 
508
                    dict:store(cerl_trees:get_label(SubTree), ID, Acc)
 
509
                end;
 
510
              module ->
 
511
                Defs = cerl:module_defs(SubTree),
 
512
                lists:foldl(fun({Var, Fun}, Acc1) ->
 
513
                                dict:store(cerl_trees:get_label(Fun),
 
514
                                           {cerl:fname_id(Var), 
 
515
                                            cerl:fname_arity(Var)},
 
516
                                           Acc1)
 
517
                            end, Acc, Defs);
 
518
              letrec ->
 
519
                Defs = cerl:letrec_defs(SubTree),
 
520
                lists:foldl(fun({Var, Fun}, Acc1) ->
 
521
                                dict:store(cerl_trees:get_label(Fun),
 
522
                                           {cerl:fname_id(Var), 
 
523
                                            cerl:fname_arity(Var)},
 
524
                                           Acc1)
 
525
                            end, Acc, Defs);
 
526
              _ -> Acc
 
527
            end
 
528
        end,
 
529
  NameMap1 = cerl_trees:fold(Fun, dict:new(), LabeledTree),
 
530
  NameMap = dict:store(external, external, NameMap1),
 
531
  NamedEdges = lists:map(fun({X, Y}) ->
 
532
                             {dict:fetch(X, NameMap), dict:fetch(Y, NameMap)}
 
533
                         end, Edges),
 
534
  NamedEsc = lists:map(fun(X) -> dict:fetch(X, NameMap) end, Esc),
 
535
  %% Color the edges
 
536
  ColorEsc = [{X, {color, red}} || X <- NamedEsc],
 
537
 
 
538
  CallEdges0 = dict:fold(fun(Caller, Set, Acc) ->
 
539
                             [[{Caller, Callee} || Callee <- Set]|Acc]
 
540
                         end, [], Calls),
 
541
  CallEdges = lists:flatten(CallEdges0),
 
542
  NamedCallEdges = lists:map(fun({X, Y}) ->
 
543
                                 {X, dict:fetch(Y, NameMap)}
 
544
                             end, CallEdges),
 
545
 
 
546
  hipe_dot:translate_list(NamedEdges ++ NamedCallEdges, "/tmp/cg.dot", "CG", 
 
547
                          ColorEsc),
 
548
  os:cmd("dot -T ps -o /tmp/cg.ps /tmp/cg.dot"),
 
549
 
 
550
  ok.
 
551
 
 
552
-endif.