xref_utils.erl

OTP是开放电信平台的简称

    false.

%%% The following functions implement some of the operators recognized
%%% in xref_compiler.erl.

closure(S) ->
    relation_to_graph(S).

components(G) ->
    %% Returns a plain set of sets.
    from_term(digraph_utils:cyclic_strong_components(G), [[atom]]).

condensation(G) ->
    G2 = digraph_utils:condensation(G),
    %% A relation. The result can be only be used by a few set operations.
    R = graph_to_relation(G2),
    true = digraph:delete(G2),
    R.

path(G, [E]) ->
    path(G, [E,E]);
path(G, P=[E1 | _]) ->
    path(P, G, [[E1]]).

use(G, V) ->
    neighbours(to_external(V), G, reaching_neighbours, type(V)).

call(G, V) ->
    neighbours(to_external(V), G, reachable_neighbours, type(V)).

regexpr({regexpr, RExpr}, Var) ->
    Xs = match_list(to_external(Var), RExpr),
    xset(Xs, type(Var));
regexpr({ModExpr, FunExpr, ArityExpr}, Var) ->
    Type = type(Var),
    V1 = case {ModExpr,Type} of
	     {{atom, Mod},[{ModType, _}]} ->
		 restriction(Var, xset([Mod], [ModType]));
	     {{regexpr, MExpr},[{ModType, _}]} ->
		 Mods = match_list(to_external(domain(Var)), MExpr),
		 restriction(Var, xset(Mods, [ModType]));
	     {variable,_} ->
		 Var;
             {_,_} -> % Var is the empty set
                 Var
	 end,
    V2 = case FunExpr of
	     {atom, FunName} ->
		 V1L = to_external(V1),
		 xset(match_one(V1L, FunName, 2), Type);
	     {regexpr, FExpr} ->
		 V1L = to_external(V1),
		 xset(match_many(V1L, FExpr, 2), Type);
	     variable ->
		 V1
	 end,
    case ArityExpr of 
	{integer, Arity} ->
	    V2L = to_external(V2),
	    xset(match_one(V2L, Arity, 3), Type);
	{regexpr, Expr} ->
	    V2L = to_external(V2),
	    xset(match_many(V2L, Expr, 3), Type);
	variable ->
	    V2
    end.

%% -> digraph()
relation_to_graph(S) ->
    G = digraph:new(),
    Fun = fun({From, To}) -> 
		  digraph:add_vertex(G, From),
		  digraph:add_vertex(G, To),
		  digraph:add_edge(G, From, To)
	  end,
    foreach(Fun, to_external(S)),
    G.

%% -> {ok, FileName} | Error | fault()
%% Finds a module's BEAM file.
find_beam(Module) when is_atom(Module) ->
    case code:which(Module) of
	non_existing ->
	    error({no_such_module, Module});
	preloaded ->
	    {_M, _Bin, File} = code:get_object_code(Module),
	    {ok, File};
        cover_compiled ->
	    error({cover_compiled, Module});
	File ->
	    {ok, File}
    end;
find_beam(Culprit) ->
    erlang:fault(badarg, [Culprit]).

%% options(Options, ValidOptions) -> {OptionValues, InvalidOptions}
%%
%% Options = [Option] | Option
%% ValidOptions = [atom() | {OptionName, ValidValues}]
%% OptionValues = [bool() | {OptionName, [term()]}]
%% OptionName = atom()
%% InvalidOptions = [Option]
%% Option = OptionName | {OptionName, term()}
%% ValidValues = [] | [DefaultValue | [ValidValue]] | [DefaultValue, Tester]
%% ValidValue = DefaultValue = term()
%% Tester = fun([term()]) -> bool()
%%
%% A Boolean Option has a name (an atom). A Value Option has a name
%% (an atom) and a value (a term).
%%
%% ValidOptions enumerates allowed options - a Boolean Option is
%% enumerated with its name, and a Value Option is enumerated with a
%% pair {Name, Values}, where Name is the option's name and Values is
%% a list of allowed values for the Value Option, the first one being
%% the default value (by convention). An empty list of allowed values
%% means that all terms are allowed as value (and that there is no
%% default value). Also if the only allowed value is the default
%% value, all terms are allowed as value. A function argument (Tester)
%% may be used for testing the supplied values (useful for a path...)
%% An allowed option must not be enumerated more than once, but
%% allowed values may be duplicated.
%%
%% OptionValues is a list of option values, where member i is the
%% value of option i in ValidOptions. The value of a Boolean Option is
%% 'true' if the option name is mentioned in Options, otherwise
%% 'false'. The value of a Value Option is a list of the option values
%% mentioned in Options for the Value Option. If the Value Option is
%% not mentioned in Options, the list contains the default value (if
%% there is no default value, the list is empty), and if it is
%% mentioned more than once, the values are sorted in standard order.
%%
%% InvalidOptions is a list of those options present in Options that
%% do not match any allowed option mentioned in ValidOptions.
%%
options(Options, Valid) ->
    split_options(Options, [], [], [], Valid).

subprocess(Fun, Opts) ->
    Pid = spawn_opt(Fun, Opts),
    receive 
	{Pid, Reply} -> Reply
    end.

format_error({error, Module, Error}) ->
    Module:format_error(Error);
format_error({file_error, FileName, Reason}) ->
    io_lib:format("~s: ~p~n", [FileName, file:format_error(Reason)]);
format_error({unrecognized_file, FileName}) ->
    io_lib:format("~p is neither a regular file nor a directory~n", 
		  [FileName]);
format_error({no_such_module, Module}) ->
    io_lib:format("Cannot find module ~p using the code path~n", [Module]);
format_error({interpreted, Module}) ->
    io_lib:format("Cannot use BEAM code of interpreted module ~p~n", [Module]);
format_error(E) ->
    io_lib:format("~p~n", [E]).

%%
%%  Local functions
%%

to_list(X) when is_atom(X) -> atom_to_list(X);
to_list(X) when is_list(X) -> X.

select_application_directories([FileName|FileNames], Dir, Flag, L) ->
    case is_directory(FileName) of
	true ->
	    File = filename:basename(FileName),
	    {Name, Vsn} = filename_to_application(File),
	    ApplDir = {Name, Vsn, subdir(FileName, Dir, Flag)},
	    select_application_directories(FileNames, Dir, Flag, [ApplDir|L]);
	false ->
	    select_application_directories(FileNames, Dir, Flag, L);
	Error ->
	    Error
    end;
select_application_directories([], _Dir, _Flag, L) ->
    {ok,reverse(L)}.

subdir(Dir, _, false) ->
    Dir;
subdir(Dir, SubDir, true) ->
    EDir = filename:join(Dir, SubDir),
    case is_directory(EDir) of
	true -> EDir;
	_FalseOrError -> Dir
    end.

%% Avoid "App-01.01" - the zeroes will be lost.
filename2appl(File) ->
    Pos = string:rstr(File, "-"),
    true = Pos > 1,
    V = string:sub_string(File, Pos+1),
    true = string:len(V) > 0,
    VsnT = string:tokens(V, "."),
    ApplName = string:sub_string(File, 1, Pos-1),
    Vsn = [list_to_integer(Vsn) || Vsn <- VsnT],
    {list_to_atom(ApplName),Vsn}.

find_files_dir(Dir, Recurse, Collect, Watch, L) ->
    case file:list_dir(Dir) of
	{ok, Files} ->
	    find_files(sort(Files), Dir, Recurse, Collect, Watch, L);
	{error, Error} ->
	    [B | {E,J,U}] = L,
	    [B | {[file_error(Dir, Error)|E],J,U}]
    end.

find_files([F | Fs], Dir, Recurse, Collect, Watch, L) ->
    File = filename:join(Dir, F),
    L1 = case file_info(File) of
	     {ok, {_, directory, readable, _}} when Recurse ->
		 find_files_dir(File, Recurse, Collect, Watch, L);
             {ok, {_, directory, _, _}} ->
		 L;
	     Info ->
		 [B | EJU = {E,J,U}] = L,
		 Ext = filename:extension(File),
		 C = member(Ext, Collect),
		 case C of
		     true ->
			 case Info of
			     {ok, {_, file, readable, _}} ->
				 [[{Dir,F} | B] | EJU];
			     {ok, {_, file, unreadable, _}} ->
				 [B | {E,J,[File|U]}];
			     Error ->
				 [B | {[Error|E],J,U}]
			 end;
		     false ->
			 case member(Ext, Watch) of
			     true -> [B | {E,[File|J],U}];
			     false -> L
			 end
		 end
	 end,
    find_files(Fs, Dir, Recurse, Collect, Watch, L1);
find_files([], _Dir, _Recurse, _Collect, _Watch, L) ->
    L.

graph_to_relation(G) ->
    Fun = fun(E) -> {_E, V1, V2, _Label} = digraph:edge(G, E), {V1, V2} end,
    from_term(map(Fun, digraph:edges(G)), [{[atom],[atom]}]).

path([E1, E2 | P], G, L) ->
    case digraph:get_short_path(G, E1, E2) of
	false ->
	    false;
	[_V | Vs] ->
	    path([E2 | P], G, [Vs | L])
    end;
path([_], _G, L) ->
    append(reverse(L)).

neighbours(Vs, G, Fun, VT) ->
    neighbours(Vs, G, Fun, VT, []).

neighbours([V | Vs], G, Fun, VT, L) ->
    Ns = digraph_utils:Fun([V], G),
    neighbours(Ns, G, Fun, VT, L, V, Vs);
neighbours([], _G, _Fun, [VT], L) ->
    xset(L, [{VT,VT}]).

neighbours([N | Ns], G, Fun, VT, L, V, Vs) when Fun =:= reachable_neighbours ->
    neighbours(Ns, G, Fun, VT, [{V, N} | L], V, Vs);
neighbours([N | Ns], G, Fun, VT, L, V, Vs) ->
    neighbours(Ns, G, Fun, VT, [{N, V} | L], V, Vs);
neighbours([], G, Fun, VT, L, _V, Vs) ->
    neighbours(Vs, G, Fun, VT, L).

match_list(L, RExpr) ->
    {ok, Expr} = regexp:parse(RExpr),
    filter(fun(E) -> match(E, Expr) end, L).

match_one(VarL, Con, Col) ->
    select_each(VarL, fun(E) -> Con =:= element(Col, E) end).

match_many(VarL, RExpr, Col) ->
    {ok, Expr} = regexp:parse(RExpr),    
    select_each(VarL, fun(E) -> match(element(Col, E), Expr) end).

match(I, Expr) when is_integer(I) ->
    S = integer_to_list(I),
    {match, 1, length(S)} =:= regexp:first_match(S, Expr);
match(A, Expr) when is_atom(A) ->
    S = atom_to_list(A),
    {match, 1, length(S)} =:= regexp:first_match(S, Expr).

select_each([{Mod,Funs} | L], Pred) ->
    case filter(Pred, Funs) of
        [] ->
             select_each(L, Pred);
        NFuns ->
             [{Mod,NFuns} | select_each(L, Pred)]
    end;
select_each([], _Pred) ->
    [].

split_options([O | Os], A, P, I, V) when is_atom(O) ->
    split_options(Os, [O | A], P, I, V);
split_options([O={Name,_} | Os], A, P, I, V) when is_atom(Name) ->
    split_options(Os, A, [O | P], I, V);
split_options([O | Os], A, P, I, V) ->
    split_options(Os, A, P, [O | I], V);
split_options([], A, P, I, V) ->
    Atoms = to_external(set(A)),
    Pairs = to_external(relation_to_family(relation(P))),
    option_values(V, Atoms, Pairs, I, []);
split_options(O, A, P, I, V) ->
    split_options([O], A, P, I, V).

option_values([O | Os], A, P, I, Vs) when is_atom(O) ->
    option_values(Os, delete(O, A), P, I, [member(O, A) | Vs]);    
option_values([{Name, AllowedValues} | Os], A, P, I, Vs) ->
    case keysearch(Name, 1, P) of
	{value, {_, Values}} ->
	    option_value(Name, AllowedValues, Values, A, P, I, Vs, Os);
	false when AllowedValues =:= [] ->
	    option_values(Os, A, P, I, [[] | Vs]);
	false ->
	    [Default | _] = AllowedValues,
	    option_values(Os, A, P, I, [[Default] | Vs])
    end;
option_values([], A, P, Invalid, Values) ->
    I2 = to_external(family_to_relation(family(P))),
    {reverse(Values), Invalid ++ A ++ I2}.

option_value(Name, [_Deflt, Fun], Vals, A, P, I, Vs, Os) 
                                                  when is_function(Fun) ->
    P1 = keydelete(Name, 1, P),
    case Fun(Vals) of
	true ->
	    option_values(Os, A, P1, I, [Vals | Vs]);
	false ->
	    option_values(Os, A, [{Name,Vals} | P1], I, [[] | Vs])
    end;
option_value(Name, AllowedValues, Values, A, P, I, Vs, Os) ->
    P1 = keydelete(Name, 1, P),
    VS = set(Values),
    AVS = set(AllowedValues),
    V1 = to_external(intersection(VS, AVS)),
    {V, NP} = case to_external(difference(VS, AVS)) of
		  _ when AllowedValues =:= [] -> {Values,P1};
		  [] -> {V1,P1};
		  _ when length(AllowedValues) =:= 1 -> 
		      {Values,P1};
 		  I1 -> {V1,[{Name,I1} | P1]}
	      end,
    option_values(Os, A, NP, I, [V | Vs]).

file_error(File, Error) ->
    error({file_error, File, Error}).

error(Error) ->
    {error, ?MODULE, Error}.