xref_compiler.erl

OTP是开放电信平台的简称

%% ``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 2000, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id $
%%

-module(xref_compiler).

-include("xref.hrl").

%-define(debug, true).

-ifdef(debug).
-define(FORMAT(P, A), io:format(P, A)).
-define(CALL(F), F).
-else.
-define(FORMAT(P, A), ok).
-define(CALL(F), ok).
-endif.

-export([compile/2]).

-export([update_graph_counter/3]).

-export([format_error/1]).

-import(lists, 
	[concat/1, foldl/3, nthtail/2, reverse/1, sort/1, sublist/2]).

-import(sofs,
	[composite/2, difference/2, empty_set/0, from_term/1,
	 intersection/2, is_empty_set/1, multiple_relative_product/2,
	 projection/2, relation/1, relation_to_family/1,
	 restriction/2, substitution/2, to_external/1, union/2,
	 union_of_family/1]).

%%
%%  Exported functions
%%

compile(Chars, Table) ->
    case xref_scanner:scan(Chars) of
	{ok, Tokens}  ->
	    case xref_parser:parse(Tokens) of
		{ok, ParseTree} ->
		    ?FORMAT("ParseTree ~p~n", [ParseTree]),
		    case catch statements(ParseTree, Table) of
			E={error, _, _} ->
			    E;
			{ok, UV, P} ->
			    %% User variables to be.
			    Table1 = user_vars(UV, Table),
			    ?CALL(statistics(runtime)),
			    Reply = i(P, Table1),
			    ?CALL({_, Time} = statistics(runtime)),
			    ?FORMAT("Result in ~p ms~n",[Time]),
			    Reply
		    end;
		{error, {Line, _Module, Error}} ->
		    error({parse_error, Line, Error})
	    end;
	{error, Info, Line} ->
	    error({parse_error, Line, Info})
    end.
    
format_error({error, Module, Error}) ->
    Module:format_error(Error);
format_error({parse_error, Line, Error}) ->
    format_parse_error(Error, format_line(Line));
format_error({variable_reassigned, Expr}) ->
    io_lib:format("Variable assigned more than once: ~s~n", [Expr]);
format_error({unknown_variable, Name}) ->
    io_lib:format("Variable ~p used before set~n", [Name]);
format_error({type_error, Expr}) ->
    io_lib:format("Operator applied to argument(s) of different or "
		  "invalid type(s): ~s~n", [Expr]);
format_error({type_mismatch, Expr1, Expr2}) ->
    io_lib:format("Constants of different types: ~s, ~s~n",
		  [Expr1, Expr2]);
format_error({unknown_constant, Constant}) ->
    io_lib:format("Unknown constant ~s~n", [Constant]);
format_error(E) ->
    io_lib:format("~p~n", [E]).

%%
%%  Local functions
%%

user_vars([{{user,Name}, Val} | UV], Table) ->
    user_vars(UV, dict:store(Name, Val, Table));
user_vars([_V | UV], Table) ->
    user_vars(UV, Table);
user_vars([], Table) ->
    Table.

statements(Stmts, Table) ->
    statements(Stmts, Table, [], []).

statements([Stmt={assign, VarType, Name, E} | Stmts0], Table, L, UV) ->
    case dict:find(Name, Table) of
	{ok, _} ->
	    throw_error({variable_reassigned, xref_parser:t2s(Stmt)});
	error ->
	    {Type, OType, NewE} = t_expr(E, Table),
	    Val = #xref_var{name = Name, vtype = VarType, 
			    otype = OType, type = Type},
	    NewTable = dict:store(Name, Val, Table),
	    Stmts = if Stmts0 =:= [] -> [{variable, Name}]; true -> Stmts0 end,
	    Variable = {VarType, Name},
	    Put = {put, Variable, NewE},
	    statements(Stmts, NewTable, [Put | L], [{Variable,Val} | UV])
    end;
statements([Expr], Table, L, UV) ->
    {Type, OType, NewE} = t_expr(Expr, Table),
    E1 = un_familiarize(Type, OType, NewE),
    NE = case {Type, OType} of
	     %% Edges with empty sets of line numbers are removed.
	     {{line, _}, edge} -> 
		 {relation_to_family, E1};
	     {_Type, edge_closure} -> 
		 %% Fake a closure usage, just to make sure it is destroyed.
		 E2 = {fun graph_access/2, E1, E1},
                 {fun(_E) -> 'closure()' end, E2};
	     _Else -> E1
	 end,
    {ok, UV, stats(L, NE)}.

stats([{put, V, X} | Ss], E) ->
    stats(Ss, {put, V, X, E});
stats([], E) ->
    E.

t_expr(E, Table) ->
    {expr, Type, OType, E1} = check_expr(E, Table),
    ?FORMAT("TExpr:~n~p~n",[E1]),
    E2 = convert(E1),
    ?FORMAT("After conversion:~n~p~n",[E2]),
    {Type, OType, E2}.

%%% check_expr/2 translates Expr in xref_parser.yrl into TExpr:
%%%
%%% TExpr = {expr, Type, ObjectType, Expr}
%%% Expr = {constants, [Constant]}
%%%      | {variable, {VarType, VarName}}
%%%      | {call, Call, Expr}
%%%      | {call, Call, Expr, Expr}
%%%      | {call, restriction, integer(), Expr, Expr}
%%%      | {convert, ObjectType, Type, Type}
%%%      | {convert, Type, Type}
%%% Constant = atom() | {atom(), atom()} | MFA | {MFA, MFA}
%%% Call = atom() % function in the sofs module
%%%      | fun()
%%% Type = {line, LineType} | function | module | application | release 
%%%      | number
%%% LineType = line | local_call | external_call | export_call | all_line_call
%%% VarType = predef | user | tmp
%%% ObjectType = vertex | vertex_set | edge | edge_set | edge_closure | path
%%%            | number
%%% MFA = {atom(), atom(), integer()}

%% -> TExpr
check_expr({list, L}, Table) ->
    check_constants(L, Table);
check_expr({tuple, L}, Table) ->
    {expr, Type, vertex, _Consts} = check_constants(L, Table),
    Cs = reverse(constant_vertices(L, [])),
    {expr, Type, path, {constants, Cs}};
check_expr({variable, Name}, Table) ->
    case dict:find(Name, Table) of
	{ok, #xref_var{vtype = VarType, otype = OType, type = Type}} ->
	    V0 = {variable, {VarType, Name}},
	    V = case {VarType, Type, OType} of 
		    {predef, release, _} -> V0;
		    {predef, application, _} -> V0;
		    {predef, module, _} -> V0;
		    {predef, function, vertex} -> V0;
		    {predef, function, edge} -> {call, union_of_family, V0};
		    _Else  -> V0
	    end,
	    {expr, Type, OType, V};
	error ->
	    throw_error({unknown_variable, Name})
    end;
check_expr({type, {type, _Type}, E}, Table) ->
    check_expr(E, Table);
check_expr(Expr={type, {convert, NewType0}, E}, Table) ->
    NewType = what_type(NewType0),
    {expr, OldType, OType, NE} = check_expr(E, Table),
    ok = check_conversion(OType, OldType, NewType, Expr),
    {expr, NewType, OType, {convert, OType, OldType, NewType, NE}};
check_expr(Expr={set, SOp, E}, Table) ->
    {expr, Type, OType0, E1} = check_expr(E, Table),
    OType = case {OType0, SOp} of
		{edge, range} -> vertex;
		{edge, domain} -> vertex;
		{edge, weak} -> edge;
		{edge, strict} -> edge;
		{edge_set, range} -> vertex_set;
		{edge_set, domain} -> vertex_set;
		{edge_set, weak} -> edge_set;
		{edge_set, strict} -> edge_set;
		_ -> 
		    throw_error({type_error, xref_parser:t2s(Expr)})
	    end,
    Op = set_op(SOp),
    NE = function_vertices_to_family(Type, OType, {call, Op, E1}),
    {expr, Type, OType, NE};
check_expr(Expr={graph, Op, E}, Table) ->
    {expr, Type, NOType, E1} = check_expr(E, Table),
    case Type of
	{line, _LineType} ->
	    throw_error({type_error, xref_parser:t2s(Expr)});
	_Else -> 
	    ok
    end,
    OType = 
	case {NOType, Op} of
	    {edge, components} -> vertex_set;
	    {edge, condensation} -> edge_set;
	    {edge, closure} -> edge_closure;
	    {edge_closure, components} -> vertex_set;
	    {edge_closure, condensation} -> edge_set;
	    {edge_closure, closure} -> edge_closure;
	    %% Neither need nor want these ones:
	    %% {edge_set, closure} -> edge_set_closure;
	    %% {edge_set, components} -> vertex_set_set;
	    _ -> 
		throw_error({type_error, xref_parser:t2s(Expr)})
	end,
    E2 = {convert, NOType, edge_closure, E1},
    NE = case Op of
	     closure -> E2;
	     _Op -> use_of_closure(Op, E2)
	 end,
    {expr, Type, OType, NE};
check_expr(Expr={numeric, '#', E}, Table) ->
    {expr, Type, OType, E1} = check_expr(E, Table),
    case OType of
	vertex -> ok;
	vertex_set -> ok;
	edge -> ok;
	edge_set -> ok;
	_Else -> throw_error({type_error, xref_parser:t2s(Expr)})
    end,
    NE = {convert, OType, Type, number, E1},
    {expr, number, number, {call, no_elements, NE}};
check_expr(Expr={set, SOp, E1, E2}, Table) ->
    %% sets and numbers...
    {expr, Type1, OType1, NE1} = check_expr(E1, Table),
    {expr, Type2, OType2, NE2} = check_expr(E2, Table),
    OType = case {OType1, OType2} of
		{vertex, vertex} -> vertex;
		{edge, edge} -> edge;
		{number, number} -> number;
		_ -> throw_error({type_error, xref_parser:t2s(Expr)})
	    end,
    case OType of
	number ->
	    {expr, number, number, {call, ari_op(SOp), NE1, NE2}};
	_Else -> % set
	    {Type, NewE1, NewE2} = 
		case {type_ord(Type1), type_ord(Type2)} of
		    {T1, T2} when T1 =:= T2 ->
			%% Example: if Type1 = {line, line} and 
			%% Type2 = {line, export_line}, then this is not
			%% correct, but works:
			{Type1, NE1, NE2};
		    {T1, T2} when T1 < 2; T2 < 2 ->
			throw_error({type_error, xref_parser:t2s(Expr)});
		    {T1, T2} when T1 > T2 ->
			{Type2, {convert, OType, Type1, Type2, NE1}, NE2};
		    {T1, T2} when T1 < T2 ->
			{Type1, NE1, {convert, OType, Type2, Type1, NE2}}
		end,
	    Op = set_op(SOp, Type, OType),
	    {expr, Type, OType, {call, Op, NewE1, NewE2}}
    end;
check_expr(Expr={restr, ROp, E1, E2}, Table) ->
    {expr, Type1, OType1, NE1} = check_expr(E1, Table),
    {expr, Type2, OType2, NE2} = 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)});
	_ -> 
	    ok
    end,
    case {OType1, OType2} of
	{edge, vertex} when ROp =:= '|||' ->
	    {expr, _, _, R1} = restriction('|', E1, Type1, NE1, Type2, NE2),
	    {expr, _, _, R2} = restriction('||', E1, Type1, NE1, Type2, NE2),
	    {expr, Type1, edge, {call, intersection, R1, R2}};
	{edge, vertex} ->
	    restriction(ROp, E1, Type1, NE1, Type2, NE2);
	{edge_closure, vertex} when ROp =:= '|||' ->
	    {expr, _, _, R1} = 
		closure_restriction('|', Type1, Type2, OType2, NE1, NE2),