ic_pragma.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,956 行 · 第 1/4 页

%% ``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$
%%
-module(ic_pragma).


-export([pragma_reg/2,pragma_cover/3]).
-export([pragma_prefix/3,pragma_version/3,pragma_id/3]).
-export([mk_alias/3,get_alias/2,scope2id/2,id2scope/2,mk_scope/1]).
-export([mk_ref/3,get_incl_refs/1,get_local_refs/1]).
-export([get_dependencies/1, add_inh_data/3, preproc/3]).
-export([getBrokerData/3,defaultBrokerData/1,list_to_term/1]).
-export([get_local_c_headers/2,get_included_c_headers/1,is_inherited_by/3]).
-export([no_doubles/1,fetchRandomLocalType/1,fetchLocalOperationNames/2]).
-export([is_local/2]).

%% Debug
-export([print_tab/1,slashify/1,is_short/1]).

-import(lists,[suffix/2,delete/2,reverse/1,keysearch/3,member/2,last/1,flatten/1]).
-import(string,[tokens/2]).
-import(ets,[insert/2,lookup/2]).

-import(ic_forms,   [get_id2/1, get_body/1, get_line/1]).
-import(ic_util,    [to_atom/1]).
-import(ic_genobj,  [idlfile/1]).
-import(ic_options, [get_opt/2]).

-include("icforms.hrl").
-include("ic.hrl").




%% Initialization of the pragma table and
%% start of pragma registration. 
%% NOTE : this pragma registration is build
%% as a separate stage under compilation.
%% If it is to be optimised, it should be 
%% embodied in one of other compiling stages. 
pragma_reg(G,X) ->
    S = ic_genobj:pragmatab(G),
    init_idlfile(G,S),
    init_pragma_status(S),
    registerOptions(G,S),
    pragma_reg_all(G, S, [], X),
    denote_specific_code_opts(G), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    case get_pragma_compilation_status(S) of
	true ->
	    %% Remove ugly pragmas from form
	    PragmaCleanForm = cleanup(X),
	    {ok,PragmaCleanForm};
	false ->
	    ErrorNr = get_pragma_error_nr(S),
	    %% Just print the number of errors found
	    case ErrorNr > 1 of
		true ->
		    io:format("There were ~p errors found on file ~p~n",
			      [ErrorNr,get_idlfile(S)]),
		    error;
		false ->
		    io:format("There were ~p error found on file ~p~n",
			      [ErrorNr,get_idlfile(S)]),
		    error
	    end 
    end.



registerOptions(G,S) ->
    OptList = ets:tab2list(ic_genobj:optiontab(G)),
    registerOptions(G,S,OptList).


registerOptions(_G,_S,[]) ->    
    true;
registerOptions(G,S,[{{option,{broker,Scope}},{Mod,Type}}|Rest]) ->
    insert(S,
	   {codeopt,
	    reverse(tokens(Scope,":")),
	    {broker,{Mod,Type}},
	    -1,
	    nil,
	    nil}),
    registerOptions(G,S,Rest);
registerOptions(G,S,[_|Rest]) ->
    registerOptions(G,S,Rest).


%% Decide if to apply pragmas
%% by checking backend switch
applyPragmasInBe(G) ->
    case get_opt(G, be) of
	erl_plain ->
	    false;
	_ ->
	    true
    end.


%% Decide if the code option directive
%% is allowed to change backend
applyCodeOpt(G) ->
    case get_opt(G, be) of
	erl_corba -> %% Does not support codeopt
	    false;
	erl_plain -> %% Does not support codeopt
	    false;
	c_native ->  %% Does not support codeopt
	    false;
	_ ->
	    true
    end.



%% This removes all pragma records from the form.
%% When debugged, it can be enbodied in pragma_reg_all.
cleanup([],C) -> C;
cleanup([X|Xs],CSF) ->
    cleanup(Xs, CSF++cleanup(X)).

cleanup(X) when list(X) -> cleanup(X,[]);
cleanup(X) when record(X, preproc) -> [X];
cleanup(X) when record(X, pragma) -> [];
cleanup(X) when record(X, op) -> % Clean inside operation parameters
    [ X#op{params = cleanup(X#op.params,[])}];

cleanup(X) when record(X, module) ->  % Clean inside module body
    [ X#module{body = cleanup(X#module.body,[])}];

cleanup(X) when record(X, interface) ->  % Clean inside interface body
    [ X#interface{body = cleanup(X#interface.body,[])}];

cleanup(X) when record(X, except) ->  % Clean inside exception body
    [ X#except{body = cleanup(X#except.body,[])}];

cleanup(X) when record(X, struct) ->  % Clean inside struct body
    [ X#struct{body = cleanup(X#struct.body,[])}];

cleanup(X) when record(X, case_dcl) ->  % Clean inside union body
    [ X#case_dcl{label = cleanup(X#case_dcl.label,[])}];

cleanup(X) when record(X, union) ->  % Clean inside union body
    [ X#union{body = cleanup(X#union.body,[])}];

cleanup(X) when record(X, enum) ->  % Clean inside enum body
    [ X#enum{body = cleanup(X#enum.body,[])}];

cleanup(X) -> [X].




%% pragma_reg_all is top level registration for pragmas 
pragma_reg_all(_G, _S, _N, []) -> ok;
pragma_reg_all(G, S, N, [X|Xs]) ->
    pragma_reg(G, S, N, X), 
    pragma_reg_all(G, S, N, Xs).


%% pragma_reg is top level registration for pragmas 
pragma_reg(G, S, N, X)  when list(X) -> pragma_reg_list(G, S, N, X);
pragma_reg(_G, S, _N, X)  when element(1, X) == preproc ->
    case X#preproc.aux of
	[{_, _, "1"}] ->
	    IncludeEntryLNr = get_line(X#preproc.id),
	    IncludeFileName = element(3,element(3,X)),
	    insert(S,{includes,get_idlfile(S),IncludeFileName,IncludeEntryLNr});
	_Other ->
	    ok
    end,
    set_idlfile(S,element(3,element(3,X)));
pragma_reg(G, S, N, X)  when element(1, X) == pragma ->
    case applyPragmasInBe(G) of

	%% Pragmas are allowed to be
	%% applied in this this backend.
	true ->

	    File = get_idlfile(S), % The current file or an included one.
	    Type = case idlfile(G) of % Local/Included flag
		       File ->
			   local;
		       _ ->
			   included
		   end,
	    
	    %% Register pragmas into pragmatab.
	    case X of
		{pragma,{_,LineNr,"prefix"}, _To, _Apply} ->
		    insert(S,{prefix,X,LineNr,N,File,Type});

		{pragma,{_,_,"ID"},_,_} ->
		    pragma_reg_ID(G, S, N, X);

		{pragma,{_,_,"version"},_,_} ->
		    pragma_reg_version(G, S, N, X );
		
		{pragma,{_,_,"CODEOPT"},_,_} ->
		    pragma_reg_codeOpt(G,S,N,X);
		
		{pragma,{_,LineNr,BadPragma}, _To, _Apply} ->
		    io:format("Warning : on file ~p :~n",[get_idlfile(S)]),
		    io:format("  Unknown pragma directive ~p on line ~p, ignored.~n",
			      [BadPragma,LineNr])
	    end;

	%% Pragmas are not to be applied in 
	%% this backend, ignore all pragmas.
	false ->
	    true
    end,
    ok;

pragma_reg(G, S, N, X) when record(X, module) ->
    mk_ref(G,[get_id2(X) | N],mod_ref),
    mk_file_data(G,X,N,module),
    pragma_reg_all(G, S, [get_id2(X) | N], get_body(X));

pragma_reg(G, S, N, X) when record(X, interface) ->
    mk_ref(G,[get_id2(X) | N],ifc_ref),
    mk_file_data(G,X,N,interface),
    pragma_reg_all(G, S, [get_id2(X) | N], get_body(X));

pragma_reg(G, S, N, X) when record(X, op) ->  
    %% Add operation in table
    insert(S,{op,
	      get_id2(X),
	      N,
	      get_idlfile(S),
	      get_filepath(S)}),
    mk_file_data(G,X,N,op),
    pragma_reg_all(G, S, N, X#op.params);

pragma_reg(G, S, N, X) when record(X, except) -> 
    mk_ref(G,[get_id2(X) | N],except_ref),
    mk_file_data(G,X,N,except),
    pragma_reg_all(G, S, N, X#except.body);

pragma_reg(G, _S, N, X) when record(X, const) ->  
    mk_ref(G,[get_id2(X) | N],const_ref),
    mk_file_data(G,X,N,const);

pragma_reg(G, _S, N, X) when record(X, typedef) ->  
    XX = #id_of{type=X},
    lists:foreach(fun(Id) ->
			  mk_ref(G,[get_id2(Id) | N],typedef_ref),
			  mk_file_data(G,XX#id_of{id=Id},N,typedef)
		  end,
		  ic_forms:get_idlist(X));

pragma_reg(G, S, N, X) when record(X, enum) ->  
    mk_ref(G,[get_id2(X) | N],enum_ref),
    mk_file_data(G,X,N,enum),
    pragma_reg_all(G, S, N, X#enum.body);

pragma_reg(G, S, N, X) when record(X, union) ->  
    mk_ref(G,[get_id2(X) | N],union_ref),
    mk_file_data(G,X,N,union),
    pragma_reg_all(G, S, N, X#union.body);

pragma_reg(G, S, N, X) when record(X, struct) -> 
    mk_ref(G,[get_id2(X) | N],struct_ref),
    mk_file_data(G,X,N,struct),
    pragma_reg_all(G, S, N, X#struct.body);

pragma_reg(G, _S, N, X) when record(X, attr) -> 
    XX = #id_of{type=X},
    lists:foreach(fun(Id) ->
			  mk_ref(G,[get_id2(Id) | N],attr_ref),
			  mk_file_data(G,XX#id_of{id=Id},N,attr)
		  end,
		  ic_forms:get_idlist(X));
    
pragma_reg(_G, _S, _N, _X) ->  ok.




pragma_reg_list(_G, _S, _N, []) -> ok;
pragma_reg_list(G, S, N, List ) ->
    CurrentFileName = get_idlfile(S), 
    pragma_reg_list(G, S, N, CurrentFileName, List).

pragma_reg_list(_G, _S, _N, _CFN, []) -> ok;
pragma_reg_list(G, S, N, CFN, [X | Xs]) ->
    case X of
	{preproc,_,{_,_,FileName},_} ->
	    set_idlfile(S,FileName),
	    pragma_reg(G, S, N, X),
	    pragma_reg_list(G, S, N, FileName, Xs);
	_ ->
	    pragma_reg(G, S, N, X),
	    pragma_reg_list(G, S, N, CFN, Xs)
    end.





pragma_reg_ID(G, S, N, X) ->
    {pragma,{_,LineNr,"ID"}, _To, Apply} = X,

    
    File = get_idlfile(S), % The current file or an included one.
    Type = case idlfile(G) of % Local/Included flag
	       File ->
		   local;
	       _ ->
		   included
	   end,
    
    %% Check if ID is one of the allowed types :
    %%    * OMG IDL
    %%    * DCE UUID
    %%    * LOCAL
    case tokens(element(3,Apply),":") of
	["IDL",_,_] ->
	    insert(S,{id,X,LineNr,N,File,Type});
	["DCE",_,VSN] ->
	    case is_short(VSN) of
		true ->
		    insert(S,{id,X,LineNr,N,File,Type});
		false ->
		    set_compilation_failure(S),
		    io:format("Error on file ~p :~n",[get_idlfile(S)]),
		    io:format("  Bad pragma ID ~p on line ~p,~n",
			      [element(3,Apply),LineNr]),
		    io:format("  the version part of ID is not a short integer.~n")
	    end;
	["LOCAL"|_] ->
	    insert(S,{id,X,LineNr,N,File,Type});
	_ ->
	    set_compilation_failure(S),
	    io:format("Error on file ~p :~n",[get_idlfile(S)]),
	    io:format("  Bad pragma ID ~p on line ~p.~n",
		      [element(3,Apply),LineNr])
    end.



pragma_reg_version(G, S, N, X) ->
    {pragma,{_,LineNr,"version"}, _To, Apply} = X,

    File = get_idlfile(S), % The current file or an included one.
    Type = case idlfile(G) of % Local/Included flag
	       File ->
		   local;
	       _ ->
		   included
	   end,

    case tokens(Apply,".") of
	[Major,Minor] ->
	    case is_short(Major) and is_short(Minor) of
		true ->
		    insert(S,{version,X,LineNr,N,File,Type});
		false ->
		    set_compilation_failure(S),
		    io:format("Error on file ~p :~n",[get_idlfile(S)]),
		    io:format("  Bad pragma version ~p on line ~p,~n",
			      [Apply,LineNr]),
		    io:format("  the version is not valid.~n")
	    end;
	_ ->
	    set_compilation_failure(S),
	    io:format("Error on file ~p :~n",[get_idlfile(S)]),
	    io:format("  Bad pragma version ~p on line ~p,~n",
		      [Apply,LineNr]),
	    io:format("  the version is not valid.~n")
    end.


pragma_reg_codeOpt(G, S, _N, {pragma,{_,LineNr,"CODEOPT"},_,Apply} )->
    case applyCodeOpt(G) of
	true ->
	    {_,_,OptionList_str} = Apply,
	    case  list_to_term(OptionList_str) of
		error ->
		    ic_error:error(G,{pragma_code_opt_bad_option_list,LineNr});
		OptionList ->
		    case lists:keysearch(be,1,OptionList) of
			false ->
			    %% Add the terms of the option list 
			    %% to the compiler option list 
			    applyCodeOpts(G,S,LineNr,OptionList);
			{value, {be,Type}} ->
			    %% If backend is set from user,
			    %% let the same backend be otherwize 
			    %% set backend by codeOpt directive
			    case get_opt(G, be) of
				false ->
				    %% Add the terms of the option list 
				    %% to the compiler option list 
				    applyCodeOpts(G,S,LineNr,OptionList);
				_ ->
				    %% Add all the terms of the option list 
				    %% to the compiler option list but the
				    %% backend option
				    applyCodeOpts(G,
						  S,
						  LineNr,
						  lists:delete({be,Type},OptionList))
			    end
		    end
	    end;
	false ->
	    true
    end.



applyCodeOpts(_,_,_,[]) ->
    true;
applyCodeOpts(G,S,LNr,[{{broker,Scope},{M,T}}|Xs]) ->
    ScopedId = reverse(tokens(Scope,":")),
    case ets:match(S,
		   {codeopt,ScopedId,
		    '$1','$2','_','_'}) of
	[] ->    
	    %% Add pragma in table
	    insert(S,
		   {codeopt,
		    ScopedId,
		    {broker,{M,T}},
		    LNr,
		    get_idlfile(S),
		    get_filepath(S)}),
	    %% Continue
	    applyCodeOpts(G,S,LNr,Xs);
	_ ->
	    %% Use the code option
	    %% from user and continue
	    applyCodeOpts(G,S,LNr,Xs)
    end;
applyCodeOpts(G,S,LNr,[X|Xs]) ->
    case is_allowed_opt(X) of
	true ->
	    %% Add that term of the option list 
	    %% to the compiler option list      
	    ic_options:add_opt(G, [X], true),
	    %% Continue
	    applyCodeOpts(G,S,LNr,Xs);
	false ->
	    %% Print warning and continue
	    io:format("Warning on file ~p :~n",[get_idlfile(S)]),
	    io:format("  Bad option in pragma : ~p, ignored !~n",[X]),
	    applyCodeOpts(G,S,LNr,Xs)
    end.


is_allowed_opt({X,Y}) ->
    ic_options:allowed_opt(X,Y);
is_allowed_opt(_X) ->
    false.
    
	 

%% Returns a tuple { PFX, VSN, ID }, that is the  
%% pragma prefix, version and id coverages of
%% the scope SCOPE. This is done by use of the 
%% function pragma_cover/4.
pragma_cover(G,Scope,Object) ->
    pragma_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).

%% Returns a tuple { PFX, VSN, ID }, that is the  
%% pragma prefix, version and id coverages of
%% the scope SCOPE
pragma_cover(PragmaTab,Name,Scope,LineNr) ->
    PFX = pragma_prefix_cover(PragmaTab,Name,Scope,LineNr), 
    VSN = pragma_version_cover(PragmaTab,Name,Scope,LineNr),
    ID = pragma_id_cover(PragmaTab,Name,Scope,LineNr),
    { PFX, VSN, ID }.