xref_compiler.erl

OTP是开放电信平台的简称

	    {expr, _, _, R2} = 
		closure_restriction('||', Type1, Type2, OType2, NE1, NE2),
	    {expr, Type1, edge, {call, intersection, R1, R2}};
	{edge_closure, vertex} -> 
	    closure_restriction(ROp, Type1, Type2, OType2, NE1, NE2);
	_ -> 
	    throw_error({type_error, xref_parser:t2s(Expr)})
    end;
check_expr(Expr={path, E1, E2}, Table) ->
    {expr, Type1, OType1a, E1a} = check_expr(E1, Table),
    {expr, Type2, OType2, E2a} = check_expr(E2, Table),
    case {Type1, Type2} of
	{{line, _LineType1}, _Type2} ->
	    throw_error({type_error, xref_parser:t2s(Expr)});
	{_Type1, {line, _LineType2}} ->
	    throw_error({type_error, xref_parser:t2s(Expr)});
	_Else ->
	    ok
    end,
    E2b = {convert, OType2, Type2, Type1, E2a},
    {OType1, NE1} = path_arg(OType1a, E1a),
    NE2 = case {OType1, OType2} of 
	      {path, edge} -> {convert, OType2, edge_closure, E2b};
	      {path, edge_closure} when Type1 =:= Type2 -> E2b;
	      _ -> throw_error({type_error, xref_parser:t2s(Expr)})
	  end,
    {expr, Type1, path, use_of_closure(path, NE2, NE1)};
check_expr({regexpr, RExpr, Type0}, _Table) ->
    %% Using the "universal" variables is not optimal as regards speed,
    %% but it is simple...
    Type = what_type(Type0),
    V = case Type of
	    function -> v;
	    module -> 'M';
	    application -> 'A';
	    release -> 'R'
	end,
    Var = {variable, {predef, V}},
    Call = {call, fun(E, V2) -> xref_utils:regexpr(E, V2) end, 
	    {constants, RExpr}, Var},
    {expr, Type, vertex, Call};
check_expr(C={constant, _Type, _OType, _C}, Table) ->
    check_constants([C], Table).

path_arg(edge, E={constants, C}) ->
    case to_external(C) of
	[{V1,V2}] -> {path, {constants, [V1, V2]}};
	_ -> {edge, E}
    end;
path_arg(OType, E) ->
    {OType, E}.

check_conversion(OType, Type1, Type2, Expr) ->
    case conversions(OType, Type1, Type2) of
	ok -> ok;
	not_ok -> throw_error({type_error, xref_parser:t2s(Expr)})
    end.

%% Allowed conversions.
conversions(_OType, {line, LineType}, {line, LineType}) -> ok; 
conversions(edge, {line, _}, {line, all_line_call}) -> ok;
conversions(edge, From, {line, Line}) 
                 when is_atom(From), Line =/= all_line_call -> ok;
conversions(vertex, From, {line, line}) when is_atom(From) -> ok;
conversions(vertex, From, To) when is_atom(From), is_atom(To) -> ok;
conversions(edge, From, To) when is_atom(From), is_atom(To) -> ok;
%% "Extra":
conversions(edge, {line, Line}, To) 
                 when is_atom(To), Line =/= all_line_call -> ok;
conversions(vertex, {line, line}, To) when is_atom(To) -> ok;
conversions(_OType, _From, _To) -> not_ok.

set_op(union, {line, _LineType}, edge) -> family_union;
set_op(intersection, {line, _LineType}, edge) -> family_intersection;
set_op(difference, {line, _LineType}, edge) -> family_difference;
set_op(union, function, vertex) -> family_union;
set_op(intersection, function, vertex) -> family_intersection;
set_op(difference, function, vertex) -> family_difference;
set_op(SOp, _Type, _OType) -> SOp.

set_op(weak) -> weak_relation;
set_op(strict) -> strict_relation;
set_op(Op) -> Op.

ari_op(union) -> fun(X, Y) -> X + Y end;
ari_op(intersection) -> fun(X, Y) -> X * Y end;
ari_op(difference) -> fun(X, Y) -> X - Y end.

restriction(ROp, E1, Type1, NE1, Type2, NE2) ->
    {Column, _} = restr_op(ROp),
    case NE1 of 
	{call, union_of_family, _E} when ROp =:= '|' ->
	    restriction(Column, Type1, E1, Type2, NE2);
	{call, union_of_family, _E} when ROp =:= '||' ->
	    E1p = {inverse, E1},
	    restriction(Column, Type1, E1p, Type2, NE2);
	_ ->
	    NE2a = {convert, vertex, Type2, Type1, NE2},
	    NE2b = family_to_function_vertices(Type1, vertex, NE2a),
	    {expr, Type1, edge, {call, restriction, Column, NE1, NE2b}}
    end.

restriction(Column, Type1, VE, Type2, E2) when Type1 =:= function ->
    M = {convert, vertex, Type2, module, E2},
    Restr = {call, union_of_family, {call, restriction, VE, M}},
    C = {convert, vertex, Type2, Type1, E2},
    F = family_to_function_vertices(Type1, vertex, C),
    {expr, Type1, edge, {call, restriction, Column, Restr, F}}.

closure_restriction(Op, Type1, Type2, OType2, E1, E2) ->
    {_, Fun} = restr_op(Op),
    E2a = {convert, OType2, Type2, Type1, E2},
    E2b = family_to_function_vertices(Type1, vertex, E2a),
    {expr, Type1, edge, use_of_closure(Fun, E1, E2b)}.

restr_op('|')  -> {1, call};
restr_op('||') -> {2, use}.

%% Closures (digraphs) must be deleted, but not too soon. A wrapper
%% is inserted here for every use of a closure, to make sure that a
%% 'save' and an 'unput' instruction are inserted for every digraph, in
%% particular the temporary ones. The 'unput' instruction must occur
%% _after_ the call to the function that uses the digraph (the default
%% is that it is inserted _before_ the call).
use_of_closure(Op, C) ->
    access_of_closure(C, {call, fun(X) -> xref_utils:Op(X) end, C}).

use_of_closure(Op, C, E) ->
    access_of_closure(C, {call, fun(X, Y) -> xref_utils:Op(X, Y) end, C, E}).

access_of_closure(C, E) ->
    {call, fun graph_access/2, C, E}.

check_constants(Cs=[C={constant, Type0, OType, _Con} | Cs1], Table) ->
    check_mix(Cs1, Type0, OType, C),
    Types = case Type0 of
		unknown -> ['Rel', 'App', 'Mod'];
		T -> [T]
	    end,
    case split(Types, Cs, Table) of
	[{TypeToBe, _Cs}] ->
            S = from_term([Con || {constant, _T, _OT, Con} <- Cs]),
	    Type = what_type(TypeToBe),
	    E = function_vertices_to_family(Type, OType, {constants, S}),
	    {expr, Type, OType, E};
	[{Type1, [C1|_]}, {Type2, [C2|_]} | _] ->
	    throw_error({type_mismatch, 
			 make_vertex(Type1, C1), 
			 make_vertex(Type2, C2)})
    end.

check_mix([C={constant, 'Fun', OType, _Con} | Cs], 'Fun', OType, _C0) ->
    check_mix(Cs, 'Fun', OType, C);
check_mix([C={constant, Type, OType, _Con} | Cs], Type0, OType, _C0)
         when Type =/= 'Fun', Type0 =/= 'Fun' ->
    check_mix(Cs, Type, OType, C);
check_mix([C | _], _Type0, _OType0, C0) ->
    throw_error({type_mismatch, xref_parser:t2s(C0), xref_parser:t2s(C)});
check_mix([], _Type0, _OType0, _C0) -> 
    ok.

split(Types, Cs, Table) ->
    Vs = from_term(constant_vertices(Cs, [])),
    split(Types, Vs, empty_set(), unknown, Table, []).

split([Type | Types], Vs, AllSoFar, _Type, Table, L) ->
    S0 = known_vertices(Type, Vs, Table),
    S = difference(S0, AllSoFar),
    case is_empty_set(S) of
	true -> 
	    split(Types, Vs, AllSoFar, Type, Table, L);
	false -> 
	    All = union(AllSoFar, S0),
	    split(Types, Vs, All, Type, Table, 
		  [{Type, to_external(S)} | L])
    end;
split([], Vs, All, Type, _Table, L) ->
    case to_external(difference(Vs, All)) of
	[] -> L;
	[C|_] -> throw_error({unknown_constant, make_vertex(Type, C)})
    end.

make_vertex(Type, C) -> 
    xref_parser:t2s({constant, Type, vertex, C}).

constant_vertices([{constant, _Type, edge, {A,B}} | Cs], L) ->
    constant_vertices(Cs, [A, B | L]);
constant_vertices([{constant, _Type, vertex, V} | Cs], L) ->
    constant_vertices(Cs, [V | L]);
constant_vertices([], L) ->
    L.

known_vertices('Fun', Cs, T) ->
    M = projection(1, Cs),
    F = union_of_family(restriction(fetch_value(v, T), M)),
    intersection(Cs, F);
known_vertices('Mod', Cs, T) ->
    intersection(Cs, fetch_value('M', T));
known_vertices('App', Cs, T) ->
    intersection(Cs, fetch_value('A', T));
known_vertices('Rel', Cs, T) ->
    intersection(Cs, fetch_value('R', T)).

function_vertices_to_family(function, vertex, E) ->
    {call, partition_family, 1, E};
function_vertices_to_family(_Type, _OType, E) ->
    E.

family_to_function_vertices(function, vertex, E) ->
    {call, union_of_family, E};
family_to_function_vertices(_Type, _OType, E) ->
    E.

-define(Q(E), {quote, E}).

convert({inverse, {variable, Variable}}) ->
    {get, {inverse, var_name(Variable)}};
convert({variable, Variable}) ->
    {get, var_name(Variable)};
convert({convert, FromOType, ToOType, E}) ->
    convert(convert(E), FromOType, ToOType);
convert({convert, OType, FromType, ToType, E}) ->
    convert(convert(E), OType, FromType, ToType);
convert({call, Op, E}) ->
    {Op, convert(E)};
convert({call, Op, E1, E2}) ->
    {Op, convert(E1), convert(E2)};
convert({call, Op, E1, E2, E3}) ->
    {Op, convert(E1), convert(E2), convert(E3)};
convert({constants, Constants}) ->
    ?Q(Constants);
convert(I) when is_integer(I) ->
    ?Q(I).

var_name({predef, VarName}) -> VarName;
var_name(Variable) -> Variable.

convert(E, OType, OType) ->
    E;
convert(E, edge, edge_closure) ->
    {fun(S) -> xref_utils:closure(S) end, E}.

convert(E, OType, FromType, number) ->
    un_familiarize(FromType, OType, E);
convert(E, OType, FromType, ToType) ->
    case {type_ord(FromType), type_ord(ToType)} of
        {FT, To} when FT =:= To ->
            E;
	{FT, ToT} when FT > ToT ->
            special(OType, FromType, ToType, E);
	{FT, ToT} when FT < ToT ->
            general(OType, FromType, ToType, E)
    end.

-define(T(V), {tmp, V}).

general(_ObjectType, FromType, ToType, X) when FromType =:= ToType ->
    X;
general(edge, {line, _LineType}, ToType, LEs) -> 
    VEs = {projection, ?Q({external, fun({V1V2,_Ls}) -> V1V2 end}), LEs},
    general(edge, function, ToType, VEs);
general(edge, function, ToType, VEs) ->
    MEs = {projection, 
	   ?Q({external, fun({{M1,_,_},{M2,_,_}}) -> {M1,M2} end}),
	   VEs},
    general(edge, module, ToType, MEs);
general(edge, module, ToType, MEs) ->
    AEs = {image, {get, me2ae}, MEs},
    general(edge, application, ToType, AEs);
general(edge, application, release, AEs) ->
    {image, {get, ae}, AEs};
general(vertex, {line, _LineType}, ToType, L) -> 
    V = {partition_family, ?Q(1), {domain, L}},
    general(vertex, function, ToType, V);
general(vertex, function, ToType, V) ->
    M = {domain, V},
    general(vertex, module, ToType, M);
general(vertex, module, ToType, M) ->
    A = {image, {get, m2a}, M},
    general(vertex, application, ToType, A);
general(vertex, application, release, A) ->
    {image, {get, a2r}, A}.

special(_ObjectType, FromType, ToType, X) when FromType =:= ToType ->
    X;
special(edge, {line, _LineType}, {line, all_line_call}, Calls) ->
   {put, ?T(mods), 
       {projection, 
	?Q({external, fun({{{M1,_,_},{M2,_,_}},_}) -> {M1,M2} end}), 
	Calls},
       {put, ?T(def_at), 
           {union, {image, {get, def_at},
                           {union, {domain, {get, ?T(mods)}}, 
                                   {range, {get, ?T(mods)}}}}},
           {fun funs_to_lines/2,
	           {get, ?T(def_at)}, Calls}}};
special(edge, function, {line, LineType}, VEs) ->
    Var = if 
	      LineType =:= line -> call_at;
	      LineType =:= export_call -> e_call_at;
	      LineType =:= local_call -> l_call_at;
	      LineType =:= external_call -> x_call_at
	  end,
    line_edges(VEs, Var);
special(edge, module, ToType, MEs) ->
    VEs = {image,
	   {projection, 
	    ?Q({external, fun(FE={{M1,_,_},{M2,_,_}}) -> {{M1,M2},FE} end}),
	    {union, 
	     {image, {get, e},