is their a program for plotting supervision trees???

Thomas Arts <>
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 <> 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