is their a program for plotting supervision trees???
Thomas Arts
thomas@REDACTED
Wed Feb 6 09:18:50 CET 2002
The project on which Jan Nyström is working deals with
visualization of applications (in particular the AXD 301
applications). Visualizing the supervision tree is part
of that.
I wrote a prototype for the work Jan Nyström started of with.
Three modules are attached for those of you that are interested.
Regards
Thomas
Attached are:
visualize.erl
app.erl
eval.erl
you need a small modification in the graph drawing package
of Hans Nilsson from the open source user contributions:
http://www.erlang.org/contrib/graph_draw-0.0.tgz
The function supertree/2 is added:
diff
4c4
< -export([start/1, start/4, supertree/2,
---
> -export([start/1, start/4,
25,33d24
<
< % added by Thomas (June 2001)
< supertree(CallBack,UsersData) ->
< spawn(?MODULE, init,
< [CallBack, UsersData,
< #gdtop_options{title = "Supervision Tree"},
< #gd_options{cyclic = false,
< horizontal = false,
< graph_font={screen,16}, algorithm=tree}]).
After installing and modifying the graph drawing package you
can run the software on a supervision tree.
Given a call mymodule:start(Arg1,...,Argn) to start your topnode
supervision process, you can visualize the tree with:
visualize:supervisor(mymodule,start,[Arg1,...,Argn]).
Good luck
Luke Gorrie wrote:
>
> Joe Armstrong <joe@REDACTED> writes:
>
> > has anybody written a program for
> > plotting the static structure of a supervision tree from
> > its specification??
>
> Sounds like what Jan Nyström presented at the Erlang Workshop? Perhaps
> his was more blood and guts than just going from a specification.. his
> paper is at http://citeseer.nj.nec.com/453431.html, not sure if the
> code is posted anywhere.
>
> Cheers,
> Luke
-------------- next part --------------
% static analysis of application
%
% Thomas Arts
% November 2000
-module(app).
-define(WARNING(F,A),io:format("Warning: "++F,A)).
%-define(DEBUG(F,A),io:format("Debug: "++F,A)).
-define(DEBUG(F,A),ok).
-define(ERROR(Reasons),begin io:format("~p~n",[Reasons]), {error,Reasons} end).
-export([start/1,
start/2,
nonapp/3,
parse/2]).
-import(lists,[map/2]).
% app:start(App) should be called instead
% of application:start(App)
% be sure the .app file is readable and the sources are either in
% ../src/ from the directory in which .app is situated or
% in the same directory as .app file.
% app:supervision(Mod,StartArgs) should be called instead
% of supervision:start_link(Mod,StartArgs)
% be sure the Mod file and all calling sources are in present dir
start(Application) ->
start([],Application).
start(IncludePath,Application) ->
Directory =
find_app(Application),
AppSpec =
parse(Directory,Application),
analyse_app(IncludePath,Directory,AppSpec).
nonapp(Module,Func,Args) ->
analyse_to_sup([],".",{application,unknown,[]},top,Module,Func,Args).
analyse_app(IncludePath,Dir,AppSpec) ->
{application,Name,Spec} = AppSpec,
case lists:keysearch(mod,1,Spec) of
{value,{mod,{Mod,Arg}}} ->
{application,Name,
[analyse_to_sup(IncludePath,Dir,AppSpec,app_master,
Mod,start,[normal,Arg])]};
_ ->
?ERROR(["cannot determine start module"])
end.
analyse_to_sup(IncludePath,Dir,AppSpec,SupName,Mod,Func,Args) ->
% the Mod:Func(Args) function should now evaluate
% to a process that is the top of the supervisor tree
?DEBUG("~p:~p/~p should lead to supervisor:start_link~n",
[Mod,Func,length(Args)]),
case readprog(IncludePath,Dir,Mod) of
{ok,AbsForms} ->
case evaluate(IncludePath,Dir,AppSpec,AbsForms,Func,Args) of
{value,{supervisor,start_link,[M,A]},_} ->
{supervisor,SupName,analyse_sup(IncludePath,Dir,AppSpec,M,A)};
{value,{supervisor,start_link,[SN,M,A]},_} ->
{supervisor,SN,analyse_sup(IncludePath,Dir,AppSpec,M,A)};
{value,ignore,_} ->
{supervisor,ignored,[]};
Other ->
?ERROR(["no supervisor started",Other])
end;
{error,Reason} ->
?ERROR(["parse_error module "++atom_to_list(Mod)++".erl", Reason])
end.
analyse_sup(IncludePath,Dir,AppSpec,Mod,Arg) ->
?DEBUG("computing supervisor structure ~p:init(~p)~n",[Mod,Arg]),
case readprog(IncludePath,Dir,Mod) of
{ok,AbsForms} ->
% the Mod:init(Arg) function should evaluate to a
% data structure describing the supervisor specification
case catch evaluate(IncludePath,Dir,AppSpec,AbsForms,init,[Arg]) of
{value,{ok,{{SupType,_,_},ChildSups}},_} ->
map(fun(X)->
analyse_worker(IncludePath,Dir,AppSpec,SupType,X)
end,ChildSups);
Other ->
?ERROR(["supervisor wrong return value for init/1", Other])
end;
{error,Reason} ->
?ERROR(["parse_error module "++atom_to_list(Mod)++".erl", Reason])
end.
analyse_worker(IncludePath,Dir,AppSpec,SupType,
{Name,{Mod,Start,Args},Restart,_,supervisor,_}) ->
% a supervisor again, that should be analysed differently
analyse_to_sup(IncludePath,Dir,AppSpec,Name,Mod,Start,Args);
analyse_worker(IncludePath,Dir,AppSpec,SupType,
{Name,{Mod,Start,Args},Restart,_,worker,_}) ->
?DEBUG("computing worker ~p:~p/~p~n",[Mod,Start,length(Args)]),
case readprog(IncludePath,Dir,Mod) of
{ok,AbsForms} ->
% case grepbehaviour(AbsForms) of
% none ->
% {SupType,Name,{{Mod,Start,Args},Restart,worker}};
% Behaviour ->
% end
% THIS IS DANGEROUS, the function could loop infinitely
case catch evaluate(IncludePath,Dir,AppSpec,AbsForms,Start,Args) of
{value,{gen_server,start,[M,As,_]},_} ->
{SupType,Name,nolink(Mod,Start,length(Args),Name)};
{value,{gen_server,start,[SName,M,As,_]},_} ->
{SupType,checkname(Mod,Start,length(Args),Name,SName),
nolink(Mod,Start,length(Args),Name)};
{value,{gen_server,start_link,[M,As,_]},_} ->
{SupType,Name,{{M,init,[As]},Restart,gen_server,
[{started,[{Start,length(Args)}]}
]}};
{value,{gen_server,start_link,[SName,M,As,_]},_} ->
CheckedName =
checkname(Mod,Start,length(Args),Name,SName),
{SupType,CheckedName,
{{M,init,[As]},Restart,gen_server,
[{registered,CheckedName},
{started,[{Start,length(Args)}]}
]}};
{value,{gen_fsm,start,[M,As,_]},_} ->
{SupType,Name,nolink(Mod,Start,length(Args),Name)};
{value,{gen_fsm,start,[SName,M,As,_]},_} ->
{SupType,checkname(Mod,Start,length(Args),Name,SName),
nolink(Mod,Start,length(Args),Name)};
{value,{gen_fsm,start_link,[M,As,_]},_} ->
{SupType,Name,{{M,init,[As]},Restart,gen_fsm,
[{started,[{Start,length(Args)}]}
]}};
{value,{gen_fsm,start_link,[SName,M,As,_]},_} ->
CheckedName =
checkname(Mod,Start,length(Args),Name,SName),
{SupType,CheckedName,
{{M,init,[As]},Restart,gen_fsm,
[{registered,CheckedName},
{started,[{Start,length(Args)}]}
]}};
{value,{gen_event,start,[]},_} ->
{SupType,Name,nolink(Mod,Start,length(Args),Name)};
{value,{gen_event,start,[SName]},_} ->
{SupType,checkname(Mod,Start,length(Args),Name,SName),
nolink(Mod,Start,length(Args),Name)};
{value,{gen_event,start_link,[]},_} ->
{SupType,Name,{{gen_event,start_link,[]},Restart,gen_event}};
{value,{gen_event,start_link,[SName]},_} ->
CheckedName =
checkname(Mod,Start,length(Args),Name,SName),
{SupType,CheckedName,
{{gen_event,start_link,[SName]},Restart,gen_event,
[{registered,CheckedName}]}};
{value,{spawn,As},_} ->
{SupType,Name,returntype_error(Mod,Start,length(Args),Name)};
{value,{spawn_link,As},_} ->
{SupType,Name,returntype_error(Mod,Start,length(Args),Name)};
{value,{ok,{spawn,[M,F,As]}},_} ->
{SupType,Name,nolink(Mod,Start,length(Args),Name)};
{value,{ok,{spawn,[Node,M,F,As]}},_} ->
{SupType,Name,nolink(Mod,Start,length(Args),Name)};
{value,{ok,{spawn_link,[M,F,As]}},_} ->
{SupType,Name,{{M,F,As},Restart,worker,
[{started,[{Start,length(Args)}]}
]}};
{value,{ok,{spawn_link,[Node,M,F,As]}},_} ->
{SupType,Name,{{M,F,As},Restart,worker,
[{started,[{Start,length(Args)}]}
]}};
Other ->
io:format("Unrecognized spawning: ~p~n",[Other]),
{SupType,Name,{{Mod,Start,Args},Restart,worker}}
end;
{error,enoent} -> % worker defined in other application
{SupType,Name,{{Mod,Start,Args},Restart,{worker,Mod}}};
{error,Reason} ->
?ERROR(["parse_error module "++atom_to_list(Mod)++".erl", Reason])
end.
readprog(IncludePath,Dir,Module) ->
% assume Module to be in Dir++"../src", otherwise Dir
File = atom_to_list(Module)++".erl",
case file:read_file_info(filename:join([Dir,"../src",File])) of
{ok,_} ->
?DEBUG("reading file ~p~n",[filename:join([Dir,"../src",File])]),
NewDir=filename:join([Dir,"../src"]),
epp:parse_file(filename:join([NewDir,File]),
[Dir,NewDir|IncludePath],[]);
_ ->
case file:read_file_info(filename:join([Dir,File])) of
{ok,_} ->
?DEBUG("reading file ~p~n",[filename:join([Dir,File])]),
epp:parse_file(filename:join([Dir,File]),[Dir|IncludePath],[]);
Error ->
?DEBUG("eval mod "++File++" (~p)~n",[Error]),
Error
end
end.
checkname(Mod,Start,Arity,Name,SName) ->
case SName of
Name ->
Name;
{local,Name} ->
Name;
{global,Name} ->
Name;
_ ->
io:format("Warning: named worker ~p registered as ~p in "++
atom_to_list(Mod)++":"++
atom_to_list(Start)++"/"++
integer_to_list(Arity)++"~n",
[Name,SName]),
SName
end.
grepbehaviour([]) ->
none;
grepbehaviour([{attribute,_,behaviour,Behaviour}|AbsForms]) ->
Behaviour;
grepbehaviour([_|AbsForms]) ->
grepbehaviour(AbsForms).
nolink(Mod,Start,Arity,Name) ->
Reason =
io_lib:format("Error: ~p not linked to parent in "++
atom_to_list(Mod)++":"++
atom_to_list(Start)++"/"++
integer_to_list(Arity), [Name]),
io:format("~s~n",[Reason]),
{error,lists:flatten(Reason)}.
returntype_error(Mod,Start,Arity,Name) ->
Reason =
io_lib:format(
"Error: ~p started wrongly, returntype should be {ok,Pid} in "++
atom_to_list(Mod)++":"++ atom_to_list(Start)++"/"++
integer_to_list(Arity), [Name]),
io:format("~s~n",[Reason]),
{error,lists:flatten(Reason)}.
evaluate(IncludePath,Dir,AppSpec,AbsForms,Name,Arguments) ->
LocalFunctionHandler =
fun({io,format},Args,Bindings) ->
{value,ok,Bindings};
({M,F},Args,Bindings) ->
case readprog(IncludePath,Dir,M) of
{ok,NewAbsForms} ->
{value,V,Bs} = evaluate(IncludePath,Dir,AppSpec,
NewAbsForms,F,Args),
{value,V,Bindings};
_ ->
case {M,F,Args} of
{application,get_env,[Key]} ->
{value,extract(AppSpec,Key),Bindings};
{application,get_env,[App,Key]} ->
case AppSpec of
{application,App,Spec} ->
{value,extract(AppSpec,Key),Bindings};
_ -> % different application
{value,apply(M,F,Args),Bindings}
end;
_ ->
{value,apply(M,F,Args),Bindings}
end
end;
(F,Args,Bindings) when atom(F) ->
{value,V,Bs} = evaluate(IncludePath,Dir,AppSpec,AbsForms,F,Args),
{value,V,Bindings}
end,
case [ Body || {function,_,Fun,Arity,Body}<-AbsForms,
Name==Fun, length(Arguments)==Arity ] of
[ Clauses ] ->
eval:case_clauses(list_to_tuple(Arguments),
map(fun({clause,L,Ps,Gs,B}) ->
{clause,L,[{tuple,L,Ps}],Gs,B}
end,Clauses),
[],{value,LocalFunctionHandler});
Other ->
exit({AbsForms,Other,"undefined function "++ atom_to_list(Name)++
"/"++integer_to_list(length(Arguments))})
end.
%%%-----------------------------------------------------------
find_app(AppName) ->
find_app(atom_to_list(AppName)++".app",code:get_path()).
find_app(File,[]) ->
exit("cannot find "++File);
find_app(File,[Dir|Dirs]) ->
case file:read_file_info(filename:join(Dir,File)) of
{ok,Info} ->
Dir;
_ ->
find_app(File,Dirs)
end.
parse(Dir,Application) ->
File = filename:join(Dir,atom_to_list(Application)++".app"),
?DEBUG("reading file ~p~n",[File]),
case file:read_file(File) of
{ok,Bin} ->
case erl_scan:string(binary_to_list(Bin)) of
{ok,Tokens,Line} ->
case erl_parse:parse_term(Tokens) of
{ok,Term} ->
check_app(Term,Application,File);
{error,ParseError} ->
exit({"error parsing file "++File,ParseError})
end;
Error ->
exit({"error reading file "++File,Error})
end;
{error,Reason} ->
exit({"error opening file "++File,Reason})
end.
check_app({application,AppName,Spec},Application,File) ->
{application,
case AppName of
Application ->
AppName;
_ ->
?WARNING("name conflict ~p called ~p in ~p~n",
[Application,AppName,File]),
Application
end,
Spec};
check_app(Other,Application,File) ->
exit({"error in format "++File,Other}).
extract({application,_,Spec},Key) ->
case lists:keysearch(env,1,Spec) of
{value,{env,Vars}} ->
case lists:keysearch(Key,1,Vars) of
{value,{_,Value}} ->
{ok,Value};
_ ->
?WARNING("application variable ~p undefined in .app file~n",
[Key]),
undefined
end;
_ ->
?WARNING("application variable ~p undefined in .app file~n",[Key]),
undefined
end.
-------------- next part --------------
%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved via the world wide web at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%%
%% $Id$
%%
%% Modified version by Thomas Arts
%% November 2000
-module(eval).
%% An evaluator for Erlang abstract syntax.
-export([case_clauses/4]).
-export([exprs/2,exprs/3,expr/2,expr/3,expr_list/2,expr_list/3]).
-export([new_bindings/0,bindings/1,binding/2,add_binding/3,del_binding/2]).
-export([is_constant_expr/1, partial_eval/1]).
%% The following exports are here for backwards compatibility.
-export([seq/2,seq/3,arg_list/2,arg_list/3]).
-import(lists, [reverse/1,flatmap/2,foldl/3]).
%% seq(ExpressionSeq, Bindings)
%% seq(ExpressionSeq, Bindings, LocalFuncHandler)
%% arg_list(ExpressionList, Bindings)
%% arg_list(ExpressionList, Bindings, LocalFuncHandler)
%% These calls are here for backwards compatibility (BC sucks!).
seq(Exprs, Bs) -> exprs(Exprs, Bs).
seq(Exprs, Bs, Lf) -> exprs(Exprs, Bs, Lf).
arg_list(Es, Bs) -> expr_list(Es, Bs).
arg_list(Es, Bs, Lf) -> expr_list(Es, Bs, Lf).
%% exprs(ExpressionSeq, Bindings)
%% exprs(ExpressionSeq, Bindings, LocalFuncHandler)
%% Returns:
%% {value,Value,NewBindings}
exprs(Exprs, Bs) ->
exprs(Exprs, Bs, none).
exprs(Exprs, Bs, Lf) ->
exprs(Exprs, Bs, true, Lf).
exprs([E|Es], Bs0, _, Lf) ->
{value,V,Bs} = expr(E, Bs0, Lf),
exprs(Es, Bs, V, Lf);
exprs([], Bs, V, Lf) ->
{value,V,Bs}.
%% expr(Expression, Bindings)
%% expr(Expression, Bindings, LocalFuncHandler)
%% Returns:
%% {value,Value,NewBindings}
expr(E, Bs) ->
expr(E, Bs, none).
expr({var,L,V}, Bs, Lf) ->
case binding(V, Bs) of
{value,Val} ->
{value,Val,Bs};
unbound ->
exit({{unbound,V},[{?MODULE,expr,3}]})
end;
expr({char,_,C}, Bs, Lf) ->
{value,C,Bs};
expr({integer,_,I}, Bs, Lf) ->
{value,I,Bs};
expr({float,_,F}, Bs, Lf) ->
{value,F,Bs};
expr({atom,_,A}, Bs, Lf) ->
{value,A,Bs};
expr({string,_,S}, Bs, Lf) ->
{value,S,Bs};
expr({nil, _}, Bs, Lf) ->
{value,[],Bs};
expr({cons,_,H0,T0}, Bs0, Lf) ->
{value,H,Bs1} = expr(H0, Bs0, Lf),
{value,T,Bs2} = expr(T0, Bs0, Lf),
{value,[H|T],merge_bindings(Bs1, Bs2)};
expr({lc,_,E,Qs}, Bs, Lf) ->
eval_lc(E, Qs, Bs, Lf);
expr({tuple,_,Es}, Bs0, Lf) ->
{Vs,Bs} = expr_list(Es, Bs0, Lf),
{value,list_to_tuple(Vs),Bs};
expr({record_index,_,Name,F}, Bs, Lf) ->
exit({undef_record,Name});
expr({record,_,Name,Fs}, Bs, Lf) ->
exit({undef_record,Name});
expr({record_field,_,Rec,Name,F}, Bs, Lf) ->
exit({undef_record,Name});
expr({record,_,Rec,Name,Fs}, Bs, Lf) ->
exit({undef_record,Name});
expr({record_field,_,Rec,F}, Bs, Lf) ->
exit(undef_record);
expr({block,_,Es}, Bs, Lf) ->
exprs(Es, Bs, Lf);
expr({'if',_,Cs}, Bs, Lf) ->
if_clauses(Cs, Bs, Lf);
expr({'case',_,E,Cs}, Bs0, Lf) ->
{value,Val,Bs} = expr(E, Bs0, Lf),
case_clauses(Val, Cs, Bs, Lf);
expr({'receive',_,Cs}, Bs, Lf) ->
receive_clauses(Cs, Bs, Lf, []);
expr({'receive',_, Cs, E, TB}, Bs0, Lf) ->
{value,T,Bs} = expr(E, Bs0, Lf),
receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, []);
expr({'fun',Line,{clauses,Cs}}, Bs, Lf) ->
%% This is a really ugly hack!
case length(element(3,hd(Cs))) of
0 -> {value,fun () -> eval_fun(Cs, [], Bs, Lf) end,Bs};
1 -> {value,fun (A) -> eval_fun(Cs, [A], Bs, Lf) end,Bs};
2 -> {value,fun (A,B) -> eval_fun(Cs, [A,B], Bs, Lf) end,Bs};
3 -> {value,fun (A,B,C) -> eval_fun(Cs, [A,B,C], Bs, Lf) end,Bs};
4 -> {value,fun (A,B,C,D) -> eval_fun(Cs, [A,B,C,D], Bs, Lf) end,Bs};
5 -> {value,
fun (A,B,C,D,E) -> eval_fun(Cs, [A,B,C,D,E], Bs, Lf) end,
Bs};
6 -> {value,
fun (A,B,C,D,E,F) -> eval_fun(Cs, [A,B,C,D,E,F], Bs, Lf) end,
Bs};
7 -> {value,
fun (A,B,C,D,E,F,G) -> eval_fun(Cs, [A,B,C,D,E,F,G], Bs, Lf) end,
Bs};
8 -> {value,
fun (A,B,C,D,E,F,G,H) -> eval_fun(Cs, [A,B,C,D,E,F,G,H], Bs, Lf) end,
Bs};
9 -> {value,
fun (A,B,C,D,E,F,G,H,I) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I], Bs, Lf) end,
Bs};
10 -> {value,
fun (A,B,C,D,E,F,G,H,I,J) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J], Bs, Lf) end,
Bs};
11 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K], Bs, Lf) end,
Bs};
12 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K], Bs, Lf) end,
Bs};
13 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L,M) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M], Bs, Lf) end,
Bs};
14 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N], Bs, Lf) end,
Bs};
15 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], Bs, Lf) end,
Bs};
16 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], Bs, Lf) end,
Bs};
17 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], Bs, Lf) end,
Bs};
18 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], Bs, Lf) end,
Bs};
19 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S], Bs, Lf) end,
Bs};
20 -> {value,
fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], Bs, Lf) end,
Bs};
Other ->
exit({'argument_limit',{'fun',Line,Cs}})
end;
expr({call,_,{remote,_,Mod,Func},As0}, Bs0, Lf) ->
{value,M,Bs1} = expr(Mod, Bs0, Lf),
{value,F,Bs2} = expr(Func, Bs0, Lf),
{As,Bs3} = expr_list(As0, merge_bindings(Bs1, Bs2), Lf),
case {M,F,length(As)} of
{supervisor,start_link,Arity} when Arity==2; Arity==3 ->
{value,{supervisor,start_link,As},Bs3};
{gen_server,start,Arity} when Arity==3; Arity==4 ->
{value,{gen_server,start,As},Bs3};
{gen_server,start_link,Arity} when Arity==3; Arity==4 ->
{value,{gen_server,start_link,As},Bs3};
{gen_event,start,Arity} when Arity==0; Arity==1 ->
{value,{gen_event,start,As},Bs3};
{gen_event,start_link,Arity} when Arity==0; Arity==1 ->
io:format("creating an event manager~n"),
{value,{gen_event,start_link,As},Bs3};
{gen_event,add_handler,Arity} when Arity==3 ->
io:format("adding a handler ~p~n",[As]),
{value,{gen_event,add_handler,As},Bs3};
{gen_fsm,start,Arity} when Arity==3; Arity==4 ->
{value,{gen_fsm,start,As},Bs3};
{gen_fsm,start_link,Arity} when Arity==3; Arity==4 ->
{value,{gen_fsm,start_link,As},Bs3};
% do not send
{gen_server,call,Arity} when Arity==2 ->
io:format("Warning: disabled gen_server:call~n"),
{value,{gen_server,call,As},Bs3};
_ ->
case Lf of
{value,LocalHandler} ->
LocalHandler({M,F},As,Bs3);
_ ->
{value,apply(M, F, As),Bs3}
end
end;
expr({call,_,Func0,As0}, Bs0, Lf) -> %Local functions handler
{value,Func,Bs1} = expr(Func0, Bs0, Lf),
if
Func == spawn_link ->
{As,Bs2} = expr_list(As0, Bs1, Lf),
{value,{spawn_link,As},Bs2};
Func == spawn ->
{As,Bs2} = expr_list(As0, Bs1, Lf),
{value,{spawn,As},Bs2};
function(Func) ->
{As,Bs2} = expr_list(As0, Bs1, Lf),
{value,apply(Func, As),Bs2};
true ->
case erl_internal:bif(Func, length(As0)) of
true ->
{As,Bs2} = expr_list(As0, Bs1, Lf),
{value,bif(Func, As),Bs2};
false ->
local_func(Func, As0, Bs1, Lf)
end
end;
expr({'catch',_,Expr}, Bs0, Lf) ->
Ref = make_ref(),
case catch {Ref,expr(Expr, Bs0, Lf)} of
{Ref,{value,Val,Bs}=Ret} -> %Nothing was thrown (guaranteed).
Ret;
Other ->
{value,Other,Bs0}
end;
expr({match,_,Lhs,Rhs0}, Bs0, Lf) ->
{value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf),
case match(Lhs, Rhs, Bs1) of
{match,Bs} ->
{value,Rhs,Bs};
nomatch ->
exit({{badmatch,Rhs},[{?MODULE,expr,3}]})
end;
expr({op,_,Op,A0}, Bs0, Lf) ->
{value,A,Bs} = expr(A0, Bs0, Lf),
{value,eval_op(Op, A),Bs};
expr({op,_,Op,L0,R0}, Bs0, Lf) ->
{value,L,Bs1} = expr(L0, Bs0, Lf),
{value,R,Bs2} = expr(R0, Bs0, Lf),
{value,eval_op(Op, L, R),merge_bindings(Bs1, Bs2)};
expr({bin,_,Fs}, Bs0, Lf) ->
eval_bits:expr_grp(Fs,Bs0,
fun(E, B) -> expr(E, B, Lf) end,
[],
true);
expr({remote,_,M,F}, Bs, Lf) ->
exit({{badexpr,':'},[{?MODULE,expr,3}]});
expr({field,_,Rec,F}, Bs, Lf) ->
exit({{badexpr, '.'},[{?MODULE,expr,3}]});
expr({value,_,Val}, Bs, Lf) -> %Special case straight values.
{value,Val,Bs}.
%% local_func(Function, Arguments, Bindings, LocalFuncHandler) ->
%% {value,Value,Bindings} when
%% LocalFuncHandler = {value,F}|{value,F,Eas}|{eval,F}|{eval,F,Eas}|none.
local_func(Func, As0, Bs0, {value,F}) ->
{As1,Bs1} = expr_list(As0, Bs0, {value,F}),
% changed this
% {value,apply(F, [Func,As1]),Bs1};
% to
F(Func,As1,Bs1);
local_func(Func, As0, Bs0, {value,F,Eas}) ->
{As1,Bs1} = expr_list(As0, Bs0, {value,F,Eas}),
{value,apply(F, [Func,As1|Eas]),Bs1};
local_func(Func, As, Bs, {eval,F}) ->
apply(F, [Func,As,Bs]);
local_func(Func, As, Bs, {eval,F,Eas}) ->
apply(F, [Func,As,Bs|Eas]);
%% These two clauses are for backwards compatibility.
local_func(Func, As0, Bs0, {M,F}) ->
{As1,Bs1} = expr_list(As0, Bs0, {M,F}),
{value,apply(M, F, [Func,As1]),Bs1};
local_func(Func, As, Bs, {M,F,Eas}) ->
apply(M, F, [Func,As|Eas]);
%% Default unknown function handler to undefined function.
local_func(Func, As0, Bs0, none) ->
exit({undef,[{?MODULE,Func,length(As0)}]}).
%% eval_lc(Expr, [Qualifier], Bindings, LocalFunctionHandler) ->
%% {value,Value,Bindings}.
%% This is evaluating list comprehensions "straight out of the book".
eval_lc(E, Qs, Bs, Lf) ->
{value,eval_lc1(E, Qs, Bs, Lf),Bs}.
eval_lc1(E, [{generate,_,P,L0}|Qs], Bs0, Lf) ->
{value,L1,Bs1} = expr(L0, Bs0, Lf),
flatmap(fun (V) ->
case match(P, V, new_bindings()) of
{match,Bsn} ->
Bs2 = add_bindings(Bsn, Bs1),
eval_lc1(E, Qs, Bs2, Lf);
nomatch -> []
end end, L1);
eval_lc1(E, [F|Qs], Bs0, Lf) ->
case erl_lint:is_guard_test(F) of
true ->
case guard_test(F, Bs0, Lf) of
{value,true,Bs1} -> eval_lc1(E, Qs, Bs1, Lf);
{value,false,Bs1} -> []
end;
false ->
case expr(F, Bs0, Lf) of
{value,true,Bs1} -> eval_lc1(E, Qs, Bs1, Lf);
{value,false,Bs1} -> [];
Other -> exit({bad_filter,[{?MODULE,expr,3}]})
end
end;
eval_lc1(E, [], Bs, Lf) ->
{value,V,_} = expr(E, Bs, Lf),
[V].
%% eval_fun(Clauses, Arguments, Bindings, LocalFunctionHandler) ->
%% Value
eval_fun([{clause,L,H,G,B}|Cs], As, Bs0, Lf) ->
case match_list(H, As, new_bindings()) of
{match,Bsn} -> %The new bindings for the head
Bs1 = add_bindings(Bsn, Bs0), % which then shadow!
case guard(G, Bs1, Lf) of
true ->
{value,V,Bs2} = exprs(B, Bs1, Lf),
V;
false -> eval_fun(Cs, As, Bs0, Lf)
end;
nomatch ->
eval_fun(Cs, As, Bs0, Lf)
end;
eval_fun([], As, Bs, Lf) ->
exit({function_clause,[{?MODULE,'-inside-a-shell-fun-',As},
{?MODULE,expr,3}]}).
%% expr_list(ExpressionList, Bindings)
%% expr_list(ExpressionList, Bindings, LocalFuncHandler)
%% Evaluate a list of expressions "in parallel" at the same level.
expr_list(Es, Bs) ->
expr_list(Es, [], Bs, Bs, none).
expr_list(Es, Bs, Lf) ->
expr_list(Es, [], Bs, Bs, Lf).
expr_list([E|Es], Vs, BsOrig, Bs0, Lf) ->
{value,V,Bs1} = expr(E, BsOrig, Lf),
expr_list(Es, [V|Vs], BsOrig, merge_bindings(Bs1, Bs0), Lf);
expr_list([], Vs, _, Bs, Lf) ->
{reverse(Vs),Bs}.
eval_op('*', A1, A2) -> A1 * A2;
eval_op('/', A1, A2) -> A1 / A2;
eval_op('+', A1, A2) -> A1 + A2;
eval_op('-', A1, A2) -> A1 - A2;
eval_op('div', A1, A2) -> A1 div A2;
eval_op('rem', A1, A2) -> A1 rem A2;
eval_op('band', A1, A2) -> A1 band A2;
eval_op('bor', A1, A2) -> A1 bor A2;
eval_op('bxor', A1, A2) -> A1 bxor A2;
eval_op('bsl', A1, A2) -> A1 bsl A2;
eval_op('bsr', A1, A2) -> A1 bsr A2;
eval_op('<', E1, E2) -> E1 < E2;
eval_op('=<', E1, E2) -> E1 =< E2;
eval_op('>', E1, E2) -> E1 > E2;
eval_op('>=', E1, E2) -> E1 >= E2;
eval_op('==', E1, E2) -> E1 == E2;
eval_op('/=', E1, E2) -> E1 /= E2;
eval_op('=:=', E1, E2) -> E1 =:= E2;
eval_op('=/=', E1, E2) -> E1 =/= E2;
eval_op('and', E1, E2) -> E1 and E2;
eval_op('or', E1, E2) -> E1 or E2;
eval_op('xor', E1, E2) -> E1 xor E2;
eval_op('++', A1, A2) -> A1 ++ A2;
eval_op('--', A1, A2) -> A1 -- A2;
eval_op('!', E1, E2) -> E1 ! E2.
eval_op('+', A) -> A;
eval_op('-', A) -> -A;
eval_op('bnot', A) -> bnot A;
eval_op('not', A) -> not A.
%% bif(Name, Arguments)
%% Evaluate the Erlang builtin function Name. N.B. Special case apply
%% here, apply/2 needs to be explicit.
bif(apply, [M,F,As]) ->
apply(M, F, As);
bif(apply, [F,As]) ->
apply(F, As);
bif(Name, As) ->
apply(erlang, Name, As).
%% if_clauses(Clauses, Bindings, LocalFuncHandler)
if_clauses([{clause,_,[],G,B}|Cs], Bs, Lf) ->
case guard(G, Bs, Lf) of
true -> exprs(B, Bs, Lf);
false -> if_clauses(Cs, Bs, Lf)
end;
if_clauses([], Bs, Lf) ->
exit({if_clause,[{?MODULE,expr,3}]}).
%% case_clauses(Value, Clauses, Bindings, LocalFuncHandler)
case_clauses(Val, Cs, Bs, Lf) ->
case match_clause(Cs, Val, Bs, Lf) of
{B, Bs1} ->
exprs(B, Bs1, Lf);
nomatch ->
exit({{case_clause,Val},[{?MODULE,expr,3}]})
end.
%%
%% receive(Clauses, Bindings, LocalFuncHandler, Messages)
%%
receive_clauses(Cs, Bs, Lf, Ms) ->
receive
Val ->
case match_clause(Cs, Val, Bs, Lf) of
{B, Bs1} ->
merge_queue(Ms),
exprs(B, Bs1, Lf);
nomatch ->
receive_clauses(Cs, Bs, Lf, [Val|Ms])
end
end.
%%
%% receive_clauses(TimeOut, Clauses, TimeoutBody, Bindings, LocalFuncHandler)
%%
receive_clauses(T, Cs, TB, Bs, Lf, Ms) ->
{_,_} = statistics(runtime),
receive
Val ->
case match_clause(Cs, Val, Bs, Lf) of
{B, Bs1} ->
merge_queue(Ms),
exprs(B, Bs1, Lf);
nomatch ->
{_,T1} = statistics(runtime),
if
T == infinity ->
receive_clauses(T, Cs, TB, Bs, Lf, [Val|Ms]);
T-T1 =< 0 ->
receive_clauses(0, Cs, TB, Bs, Lf, [Val|Ms]);
true ->
receive_clauses(T-T1, Cs, TB, Bs, Lf, [Val|Ms])
end
end
after T ->
merge_queue(Ms),
{B, Bs1} = TB,
exprs(B, Bs1, Lf)
end.
merge_queue(Ms) ->
send_all(recv_all(Ms), self()).
recv_all(Xs) ->
receive
X -> recv_all([X|Xs])
after 0 ->
reverse(Xs)
end.
send_all([X|Xs], Self) ->
Self ! X,
send_all(Xs, Self);
send_all([], _) -> true.
%% match_clause -> {Body, Bindings} or nomatch
match_clause([{clause,_,[P],G,B}|Cs], Val, Bs, Lf) ->
case match(P, Val, Bs) of
{match, Bs1} ->
case guard(G, Bs1, Lf) of
true -> {B, Bs1};
false -> match_clause(Cs, Val, Bs, Lf)
end;
nomatch -> match_clause(Cs, Val, Bs, Lf)
end;
match_clause([], _, _, _) ->
nomatch.
%% guard(GuardTests, Bindings, LocalFuncHandler) -> true | false.
%% Evaluate a guard. We test if the guard is a true guard.
guard(L=[G|_], Bs0, Lf) when list(G) ->
guard1(L, Bs0, Lf);
guard(L, Bs0, Lf) ->
guard0(L, Bs0, Lf).
%% disjunction of guard conjunctions
guard1([G|Gs], Bs0, Lf) when list(G) ->
case guard0(G, Bs0, Lf) of
true ->
true;
false ->
guard1(Gs, Bs0, Lf)
end;
guard1([], Bs, Lf) -> false.
%% guard conjunction
guard0([G|Gs], Bs0, Lf) ->
case erl_lint:is_guard_test(G) of
true ->
case guard_test(G, Bs0, Lf) of
{value,true,Bs} -> guard0(Gs, Bs, Lf);
{value,false,Bs} -> false
end;
false ->
exit({guard_expr,[{?MODULE,expr,3}]})
end;
guard0([], Bs, Lf) -> true.
%% guard_test(GuardTest, Bindings, LocalFuncHandler) ->
%% {value,bool(),NewBindings}.
%% Evaluate one guard test. This should never fail, just return true
%% or false. We DEMAND that this is valid guard test.
guard_test({call,_,{atom,_,Name},As0}, Bs0, Lf) ->
case catch expr_list(As0, Bs0, Lf) of
{As1,Bs1} -> {value,type_test(Name, As1),Bs1};
Other -> {value,false,Bs0}
end;
guard_test({op,_,Op,Lhs0,Rhs0}, Bs0, Lf) ->
case catch begin
{[Lhs,Rhs],Bs1} = expr_list([Lhs0,Rhs0], Bs0, Lf),
{value,eval_op(Op, Lhs, Rhs),Bs1}
end of
{value,Bool,Bs2} -> {value,Bool,Bs2};
Other -> {value,false,Bs0}
end;
guard_test({atom,_,true}, Bs, Lf) -> {value,true,Bs}.
type_test(integer, [A]) when integer(A) -> true;
type_test(float, [A]) when float(A) -> true;
type_test(number, [A]) when number(A) -> true;
type_test(atom, [A]) when atom(A) -> true;
type_test(constant, [A]) when constant(A) -> true;
type_test(list, [A]) when list(A) -> true;
type_test(tuple, [A]) when tuple(A) -> true;
type_test(pid, [A]) when pid(A) -> true;
type_test(reference, [A]) when reference(A) -> true;
type_test(port, [A]) when port(A) -> true;
type_test(record, [R,A]) when atom(R), element(1, A) == R -> true;
type_test(function, [A]) when function(A) -> true;
type_test(binary, [A]) when binary(A) -> true;
type_test(_, _) -> false.
%% match(Pattern, Term, Bindings) ->
%% {match,NewBindings} | nomatch
%% Try to match Pattern against Term with the current bindings.
match(Pat, Term, Bs) ->
%io:format("match ~p ~p (~p)~n",[Pat,Term,Bs]),
catch match1(Pat, Term, Bs).
string_to_conses([], Line, Tail) ->
Tail;
string_to_conses([E|Rest], Line, Tail) ->
{cons, Line, {integer, Line, E}, string_to_conses(Rest, Line, Tail)}.
match1({atom,_,A}, A, Bs) ->
{match,Bs};
match1({integer,_,I}, I, Bs) ->
{match,Bs};
match1({float,_,F}, F, Bs) ->
{match,Bs};
match1({char,_,C}, C, Bs) ->
{match,Bs};
match1({var,_,'_'}, _, Bs) -> %Anonymous variable matches
{match,Bs}; % everything, no new bindings
match1({var,_,Name}, Term, Bs) ->
case binding(Name, Bs) of
{value,Term} ->
{match,Bs};
{value,V} ->
throw(nomatch);
unbound ->
{match,add_binding(Name, Term, Bs)}
end;
match1({match,Line,Pat1,Pat2}, Term, Bs0) ->
{match, Bs1} = match1(Pat1, Term, Bs0),
match1(Pat2, Term, Bs1);
match1({string,_,S}, S, Bs) ->
{match,Bs};
match1({nil,_}, [], Bs) ->
{match,Bs};
match1({cons,_,H,T}, [H1|T1], Bs0) ->
{match,Bs} = match1(H, H1, Bs0),
match1(T, T1, Bs);
match1({tuple,_,Elts}, Tuple, Bs) when length(Elts) == size(Tuple) ->
match_tuple(Elts, Tuple, 1, Bs);
match1({bin, _, Fs}, B, Bs0) when binary(B) ->
eval_bits:match_bits(Fs, B, Bs0,
fun(L, R, Bs) -> match1(L, R, Bs) end,
fun(E, Bs) -> expr(E, Bs, none) end,
true);
match1({op,Line,'++',{nil,_},R}, Term, Bs) ->
match1(R, Term, Bs);
match1({op,_,'++',{cons,Li,{integer,L2,I},T},R}, Term, Bs) ->
match1({cons,Li,{integer,L2,I},{op,Li,'++',T,R}}, Term, Bs);
match1({op,_,'++',{string,Li,L},R}, Term, Bs) ->
match1(string_to_conses(L, Li, R), Term, Bs);
match1({op,Line,Op,A}, Term, Bs) ->
case partial_eval({op,Line,Op,A}) of
{op,Line,Op,A} ->
throw(nomatch);
X ->
match1(X, Term, Bs)
end;
match1({op,Line,Op,L,R}, Term, Bs) ->
case partial_eval({op,Line,Op,L,R}) of
{op,Line,Op,L,R} ->
throw(nomatch);
X ->
match1(X, Term, Bs)
end;
match1(_, _, _) ->
throw(nomatch).
match_tuple([E|Es], Tuple, I, Bs0) ->
{match,Bs} = match1(E, element(I, Tuple), Bs0),
match_tuple(Es, Tuple, I+1, Bs);
match_tuple([], _, _, Bs) ->
{match,Bs}.
%% match_list(PatternList, TermList, Bindings) ->
%% {match,NewBindings} | nomatch
%% Try to match a list of patterns against a list of terms with the
%% current bindings.
match_list(Ps, Ts, Bs) ->
catch match_list1(Ps, Ts, Bs).
match_list1([P|Ps], [T|Ts], Bs0) ->
case match(P, T, Bs0) of
{match,Bs1} -> match_list1(Ps, Ts, Bs1);
nomatch -> throw(nomatch)
end;
match_list1([], [], Bs) ->
{match,Bs}.
%% new_bindings()
%% bindings(Bindings)
%% binding(Name, Bindings)
%% add_binding(Name, Value, Bindings)
%% del_binding(Name, Bindings)
new_bindings() -> orddict:new().
bindings(Bs) -> orddict:dict_to_list(Bs).
binding(Name, Bs) ->
case orddict:find(Name, Bs) of
{ok,Val} -> {value,Val};
error -> unbound
end.
add_binding(Name, Val, Bs) -> orddict:store(Name, Val, Bs).
del_binding(Name, Bs) -> orddict:erase(Name, Bs).
add_bindings(Bs1, Bs2) ->
foldl(fun ({Name,Val}, Bs) -> orddict:store(Name, Val, Bs) end,
Bs2, orddict:dict_to_list(Bs1)).
merge_bindings(Bs1, Bs2) ->
foldl(fun ({Name,Val}, Bs) ->
case orddict:find(Name, Bs) of
{ok,Val} -> Bs; %Already with SAME value
{ok,V1} -> exit({{badmatch,V1},[{?MODULE,expr,3}]});
error -> orddict:store(Name, Val, Bs)
end end,
Bs2, orddict:dict_to_list(Bs1)).
%%----------------------------------------------------------------------------
%%
%% Evaluate expressions:
%% constants and
%% op A
%% L op R
%% Things that evaluate to constants are accepted
%% and guard_bifs are allowed in constant expressions
%%----------------------------------------------------------------------------
is_constant_expr(Expr) ->
case eval_expr(Expr) of
{ok, X} when number(X) -> true;
_ -> false
end.
eval_expr(Expr) ->
case catch ev_expr(Expr) of
X when integer(X) -> {ok, X};
X when float(X) -> {ok, X};
X when atom(X) -> {ok,X};
{'EXIT',Reason} -> {error, Reason};
_ -> {error, badarg}
end.
partial_eval(Expr) ->
Line = line(Expr),
case catch ev_expr(Expr) of
X when integer(X) -> ret_expr(Expr,{integer,Line,X});
X when float(X) -> ret_expr(Expr,{float,Line,X});
X when atom(X) -> ret_expr(Expr,{atom,Line,X});
_ ->
Expr
end.
ev_expr({op,Ln,Op,L,R}) -> eval(Op, ev_expr(L), ev_expr(R));
ev_expr({op,Ln,Op,A}) -> eval(Op, ev_expr(A));
ev_expr({integer,_,X}) -> X;
ev_expr({float,_,X}) -> X;
ev_expr({atom,_,X}) -> X;
ev_expr({tuple,_,Es}) ->
list_to_tuple(lists:map(fun(X) -> ev_expr(X) end, Es));
ev_expr({nil,_}) -> [];
ev_expr({cons,_,H,T}) -> [ev_expr(H) | ev_expr(T)].
%ev_expr({call,Line,{atom,_,F},As}) ->
% true = erl_internal:guard_bif(F, length(As)),
% apply(erlang, F, lists:map(fun(X) -> ev_expr(X) end, As));
%ev_expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As}) ->
% true = erl_internal:guard_bif(F, length(As)),
% apply(erlang, F, lists:map(fun(X) -> ev_expr(X) end, As)).
%% (we can use 'apply' here now, instead of enumerating the operators)
eval('+', X, Y) -> X + Y;
eval('-', X, Y) -> X - Y;
eval('*', X, Y) -> X * Y;
eval('/', X, Y) -> X / Y;
eval('div', X, Y) -> X div Y;
eval('rem', X, Y) -> X rem Y;
eval('band', X, Y) -> X band Y;
eval('bor', X, Y) -> X bor Y;
eval('bxor', X, Y) -> X bxor Y;
eval('bsl', X, Y) -> X bsl Y;
eval('bsr', X, Y) -> X bsr Y;
eval('and', X, Y) -> X and Y;
eval('or', X, Y) -> X or Y;
eval('xor', X, Y) -> X xor Y;
eval('==', X, Y) -> X == Y;
eval('/=', X, Y) -> X /= Y;
eval('=<', X, Y) -> X =< Y;
eval('<', X, Y) -> X < Y;
eval('>=', X, Y) -> X >= Y;
eval('>', X, Y) -> X > Y;
eval('=:=', X, Y) -> X =:= Y;
eval('=/=', X, Y) -> X =/= Y;
eval('++', X, Y) -> X ++ Y;
eval('--', X, Y) -> X -- Y.
eval('+', X) -> 0 + X;
eval('-', X) -> 0 - X;
eval('bnot', X) -> bnot X;
eval('not', X) -> not X.
ret_expr(Old, New) ->
%% io:format("~w: reduced ~s => ~s~n",
%% [line(Old), erl_pp:expr(Old), erl_pp:expr(New)]),
New.
line(Expr) -> element(2, Expr).
-------------- next part --------------
% Visualisation of the supervision tree
%
% Thomas Arts
% November 2000
% Modified June 2001
-module(visualize).
-export([supervisor/3,
callback/1,
callback/2]).
-include("gd.hrl").
-import(lists,[foldr/3]).
supervisor(Mod,Func,Args) ->
SupervisorStruct =
app:nonapp(Mod,Func,Args),
gdtop:supertree({?MODULE,callback}, SupervisorStruct).
vertices({supervisor,Name,{error,Reason}},Path) ->
[{Name,error,Path}];
vertices({supervisor,Name,Children},Path) ->
{Vertices,_} =
foldr(fun(Child,{Vs,N}) ->
{vertices(Child,Path++[N])++Vs,N+1}
end,{[],1},Children),
[{Name,supervisor,Path}|Vertices];
vertices({_,Name,{error,Reason}},Path) ->
[{Name,error,Path}];
vertices({_,Name,{_,_,Behaviour,_}},Path) ->
[{Name,Behaviour,Path}].
edges([]) ->
[];
edges([{N1,T1,P1}|Vs]) ->
[{{N1,T1,P1},{N2,T2,P2}} || {N2,T2,P2}<-Vs, prefix(P1,P2)]++
edges(Vs).
prefix([],[N]) ->
true;
prefix([N|Ns],[N|Ms]) ->
prefix(Ns,Ms);
prefix(_,_) ->
false.
%get_name([],SuperTree) ->
% atom_to_list(element(2,SuperTree));
%get_name([N|Ns],{supervisor,_,Children}) ->
% % here the node must be a supervisor node
% get_name(Ns,lists:nth(N,Children)).
%%-------------------------------------------------------------
callback(graph,SuperTree) ->
Vertices = (catch vertices(SuperTree,[])),
{#gd_graph{directed=false,
cyclic=false,
vertices=Vertices,
start_vertices=[hd(Vertices)],
edges=edges(Vertices)
},
SuperTree};
callback({name_string,{Name,Type,Path}},SuperTree) ->
{io_lib:format(" ~p ~n~n ~p ",[Name,Type]),SuperTree};
callback({shape,{Name,Type,Path}},SuperTree) ->
case Type of
supervisor ->
{rectangle,SuperTree};
_ ->
{oval,SuperTree}
end.
callback({click,node,Node}) ->
io:format("clicked ~p~n",[Node]);
callback({select_node_attributes,Node}) -> [{fg,red}];
callback({old_node_attributes,{_,supervisor,_}}) -> [{fill,lightblue}];
callback({old_node_attributes,{_,error,_}}) -> [{fill,red}];
callback({old_node_attributes,{_,gen_server,_}}) -> [{fill,yellow}];
callback({old_node_attributes,{_,gen_fsm,_}}) -> [{fill,yellow}];
callback({old_node_attributes,{_,gen_event,_}}) -> [{fill,lightyellow}];
callback({old_node_attributes,{_,Worker,_}}) -> [{fill,white}];
callback({new_node_attributes,_}) -> [{fill,white}].
More information about the erlang-questions
mailing list