ic_pragma.erl

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

mk_alias(G,PragmaId,ScopedId) ->
    %io:format("~nMaking alias -> ~p~n",[PragmaId]),
    S = ic_genobj:pragmatab(G),
    insert(S,{alias,ScopedId,PragmaId}).


%% This is used to find out if the object described with
%% the scoped id is created. If this is the case, it should
%% be registered as an alias and the identity of the object 
%% is returned. Otherwize "none" is returned.
get_alias(G,ScopedId) ->
    S = ic_genobj:pragmatab(G),
    case ets:match(S,{alias,ScopedId,'$1'}) of
	[] ->
	    none;
	[[IfrId]] ->
	    %io:format("~nFound alias -> ~p~n",[IfrId]),
	    IfrId
    end.



%% Returns the alias id or constructs an id
scope2id(G,ScopedId) ->
    case get_alias(G,ScopedId) of
	none ->
	    case is_included(G,ScopedId) of
		true -> %% File included
		    get_included_IR_ID(G,ScopedId);
		false -> %% File local
		    NewIfrId = mk_id(ScopedId),    % Create a "standard" id
		    mk_alias(G,NewIfrId,ScopedId), % Create an alias
		    NewIfrId
	    end;
	IfrId ->
	    IfrId
    end.




is_included(G,ScopedId) ->
    S = ic_genobj:pragmatab(G),
    Name = ic_util:to_undersc(ScopedId),
    case ets:match(S,{file_data_included,'_','_','_','_','_',Name,'_','_'}) of
	[[]] ->
	    true;
	_ ->
	    false
    end.



get_included_IR_ID(G,ScopedId) ->
    S = ic_genobj:pragmatab(G),
    ScopedName = ic_util:to_undersc(ScopedId),
    [[Scope,Name,LNr]] = ets:match(S,{file_data_included,'_','_','_','$3','$4',ScopedName,'_','$7'}),
    {Prefix,Vsn,Id} = pragma_cover(S,Name,Scope,LNr),
    case Id of
	none ->
	    case Prefix of
		none ->
		    IR_ID = 
			lists:flatten(io_lib:format("IDL:~s:~s",[ScopedName, Vsn])),
		    ic_pragma:mk_alias(G,IR_ID,ScopedId),
		    IR_ID;
		_ ->
		    IR_ID = 
			lists:flatten(io_lib:format("IDL:~s:~s",[Prefix ++ "/" ++ ScopedName, Vsn])),
		    ic_pragma:mk_alias(G,IR_ID,ScopedId),
		    IR_ID
	    end;
	_ ->
	    ic_pragma:mk_alias(G,Id,ScopedId),
	    Id
    end.
	    




%% Returns the scope for object
id2scope(G,IfrId) ->
    S = ic_genobj:pragmatab(G),
    case lookup(S,alias) of
	[] ->
	    mk_scope(IfrId);
	AliasList ->
	    case keysearch(IfrId,3,AliasList) of
		false ->
		    mk_scope(IfrId);
		{value,{alias,ScopedId,_}} ->
		    ScopedId
	    end
    end.

%% Returns a "standard" IDL ID by getting the scope list
mk_id(ScopedId) ->
    "IDL:" ++ ic_pragma:slashify(ScopedId) ++ ":" ++ default_version().

%% Returns the scope of an object when getting a "standard" IDL ID
mk_scope(IfrId) ->
    [_,Body,_] = tokens(IfrId,":"),
    reverse(tokens(Body,"/")).



%% This is used to note the exact compiled file  
%% under pragma creation. There are two options, the 
%% main file or files included by the main file. This
%% just denotes the CURRENT file, the main file or
%% the included ones. A very usual field is the file
%% path that shows the include path of the file 

init_idlfile(G,S) ->
    IdlFile = idlfile(G),
    insert(S,{file,IdlFile,[]}).

set_idlfile(S,FileName) ->
    FilePath = get_filepath(S),
    case FilePath of
	[] ->
	    ets:delete(S,file),
	    insert(S,{file,FileName,[FileName|FilePath]});
	_ ->
	    case hd(FilePath) of
		[] ->
		    ets:delete(S,file),
		    insert(S,{file,FileName,[FileName|FilePath]});
		_ ->
		    case tl(FilePath) of
			[] ->
			    ets:delete(S,file),
			    insert(S,{file,FileName,[FileName|FilePath]});
			_ ->
			    case hd(tl(FilePath)) of
				[] ->
				    ets:delete(S,file),
				    insert(S,{file,FileName,[FileName|FilePath]});
				FileName ->
				    ets:delete(S,file),
				    insert(S,{dependency,FilePath}), % Add dependency branch
				    insert(S,{file,FileName,tl(FilePath)});
				_ ->
				    ets:delete(S,file),
				    insert(S,{file,FileName,[FileName|FilePath]})
			    end
		    end
	    end
    end.

get_idlfile(S) ->
    [FT] = lookup(S,file),
    element(2,FT).

get_filepath(S) ->
    [FT] = lookup(S,file),
    element(3,FT).


%% This returns a list of file names
%% that direct or indirect the current
%% compiled file is depended on.
get_dependencies(G) ->
    S = ic_genobj:pragmatab(G),
    case lookup(S,dependency) of
	[] ->
	    [];
	Dependencies ->
	    {get_idlfile(S),get_dependencies(Dependencies,[])}
    end.

get_dependencies([],Dependencies) ->
    no_doubles(Dependencies);
get_dependencies([{dependency,Path}|Tail],Current) ->
    get_dependencies(Tail,[hd(Path)|Current]).


no_doubles(List) ->
    no_doubles(List,[]).

no_doubles([],NoDoubles) ->
    NoDoubles;
no_doubles([X|Xs],Current) ->
    case member(X,Xs) of
	true ->
	    no_doubles(Xs,Current);
	false ->
	    no_doubles(Xs,[X|Current])
    end.




%% Pragma compilation status initialization
init_pragma_status(S) ->    
    insert(S,{status,true,0}).

%% Pragma compilation status set to failure
%% and count up the number of errors
set_compilation_failure(S) ->
    [{status,_,ErrorNr}] = lookup(S,status),
    ets:delete(S,status),
    insert(S,{status,false,ErrorNr+1}).

%% Pragma compilation status set to lookup
get_pragma_compilation_status(S) ->
    [Status] = lookup(S,status),
    element(2,Status).

%% Pragma error number
get_pragma_error_nr(S) ->
    [Status] = lookup(S,status),
    element(3,Status).


%% Short check 
is_short(N_str) when list(N_str) ->
    case is_short_decimal_str(N_str) of
	true ->
	    true;
	false ->
	    false
    end;
is_short(N) when integer(N)->
    (N < 65535) and (N > -65536);
is_short(_) -> false.


%% Check if the string is a
%% list of characters representing
%% a short. Avoid crash !.
is_short_decimal_str(N_str) ->
    case is_decimal_str(N_str) of
	true ->
	    N = list_to_integer(N_str),
	    (N < 65535) and (N > -65536); 
	false ->
	    false
    end.

%% Check if the string is a
%% list of characters representing
%% decimals.
is_decimal_str([]) ->
    true;
is_decimal_str([First|Rest]) ->
    case is_decimal_char(First) of
        true ->
            is_decimal_str(Rest);
        false ->
            false
    end.

%% True if D is a character 
%% representing a decimal (0-9).
is_decimal_char(D) ->
    case (48=<D) and (D=<57) of
	true ->
	    true;
	false ->
	    false
    end.


%% Prints out all the table
print_tab(G) ->
    io:format("~nPragmaTab = ~p~n",[ets:tab2list(ic_genobj:pragmatab(G))]).


list_to_term(List) ->
    case catch erl_scan:string(List) of
	{ok, Tokens, _} ->
	    case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
		{ok,Term} ->
		    Term;
		_ ->
		    error
	    end;
	_ ->
	    error
    end.



%% Cleanup all other code options for a specified scope
%% in the same file, but the most dominant.
cleanup_codeOptions(G,S,ScopedId) ->
    case ets:match(S,{codeopt,ScopedId,'$1','$2',idlfile(G),'$4'}) of
	[] ->
	    %% No codeOpt directive is placed inside the
	    %% currently compiled file. Try to find other
            %% directives located in included files. 
	    true;
	List -> 
	    %% A codeOpt directive is placed inside the
	    %% currently compiled file. This dominates
            %% all other directives. 
	    CodeOption = best_positioned_codeOpt(List),
	    %% Remove code options that do not affect 
	    %% the code production (redundant) 
	    remove_redundant_codeOpt(S,[ScopedId|CodeOption])
    end.


%% Best positioned is the codeopt located 
%% "highest" on the SAME file, the one with 
%% lowest line number. 
best_positioned_codeOpt([X|Xs]) -> 
    best_positioned_codeOpt(Xs,X).

best_positioned_codeOpt([],Found) ->
    Found;
best_positioned_codeOpt([X|Xs],Current) ->
    case hd(tl(X)) > hd(tl(Current)) of
	true ->
	    best_positioned_codeOpt(Xs,Current);
	false ->
	    best_positioned_codeOpt(Xs,X)
    end.


remove_redundant_codeOpt(S,[ScopedId,CodeOption,LNr,FilePath]) ->
    ets:match_delete(S,{codeopt,ScopedId,'$1','$2','$3','$4'}),
    ets:insert(S,{codeopt,ScopedId,CodeOption,LNr,last(FilePath),FilePath}).




add_inh_data(G,InclScope,X) ->
    S = ic_genobj:pragmatab(G),
    case X#interface.inherit of
	[] ->
	    true;
	[InhBody] -> 
	    Scope = [get_id2(X)|InclScope],
	    insert(S,{inherits,Scope,InhBody});
	InhList ->
	    add_inh_data(G, S, InclScope, X, InhList)
    end.

add_inh_data(_,_,_,_,[]) ->
    true;
add_inh_data(G, S, InclScope, X, [InhBody|InhBodies]) ->	
    Scope = [get_id2(X)|InclScope],
    insert(S, {inherits,Scope,InhBody}),
    add_inh_data(G, S, InclScope, X, InhBodies).


%% Returns a default broker data
defaultBrokerData(G) ->
    {to_atom(ic_genobj:impl(G)),transparent}.


%% Loops through the form and sdds inheritence data 
preproc(G, N, [X|Xs]) when record(X, interface) ->
    %% Add inheritence data to pragmatab
    ic_pragma:add_inh_data(G,N,X),
    N2 = [get_id2(X) | N],
    preproc(G, N2, get_body(X)),
    lists:foreach(fun({_Name, Body}) -> preproc(G, N2, Body) end, 
		  X#interface.inherit_body), 
    preproc(G, N, Xs);

preproc(G,N,[X|Xs]) when record(X, module) ->
    N2 = [get_id2(X) | N],
    preproc(G, N2, get_body(X)),
    preproc(G,N,Xs);

preproc(G,N,[_X|Xs]) ->
    preproc(G,N,Xs);

preproc(_G, _N, []) ->
    ok.


%% Returns a tuple / list of tuples { Mod, Type } 
%% Does not check overridence because it is the 
%% top scope for the module to be produced and
%% cannot be overriden.
getBrokerData(G,X,Scope) ->
    S = ic_genobj:pragmatab(G),
    cleanup_codeOptions(G,S,Scope),

    %% Check if it is an operation denoted
    case isOperation(S,Scope) of
	%% Yes, check options
	true ->
	    %% Look if there is a specific code option on top file
	    case hasSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G),Scope) of
		true ->
		    %% Yes, let it work
		    getBrokerData(G,S,X,Scope,[Scope],[]);
		false ->
		    %% No, try to see if there is codeoption on top file
		    case hasNonSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G)) of
			true ->
			    %% Yes, override every other specific code option
			    [_H|T] = Scope,
			    getBrokerData(G,S,X,Scope,[T],[]);
			false ->
			    %% No, let inherited specific code options work
			    getBrokerData(G,S,X,Scope,[Scope],[])
		    end
	    end;
	%% No, continue
	false ->
	    getBrokerData(G,S,X,Scope,[Scope],[])
    end.

%% Returns a tuple / list of tuples { Mod, Type }
%% Inside loop, uses overridence. 
getBrokerData(G,X,RS,Scope,CSF) ->
    S = ic_genobj:pragmatab(G),
    cleanup_codeOptions(G,S,Scope),
    OvScope = overridedFrom(S,RS,Scope),
    getBrokerData(G,S,X,RS,[OvScope],[OvScope|CSF]).



getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) when integer(First) ->
    Scope = [[First]|Rest],
    case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of
	[] ->
	    case ets:match(S,{inherits,Scope,'$1'}) of
		[] -> %% No inheritence, no pragma codeopt
		    defaultBrokerData(G); %% Default
		[InhScope] ->
		    getBrokerData(G,S,X,RS,InhScope,CSF);
		InhList ->
		    getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList)
	    end;
	[[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt
	    {Module,Type};
	List -> %% Multiple branches with pragma codeopt
	    flatten(List)
    end;

getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) ->
    getBrokerDataLoop(G,S,X,RS,[[First]|Rest],CSF);

getBrokerData(G,S,X,RS,[Scope],CSF) ->
   %io:format(" 1"),
    case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of
	[] ->
	   %io:format(" 2"),
	    case ets:match(S,{inherits,Scope,'$1'}) of
		[] -> %% No inheritence, no pragma codeopt
		   %io:format(" 5"),
		    defaultBrokerData(G); %% Default
		[InhScope] ->
		   %io:format(" 6"),
		    getBrokerData(G,S,X,RS,InhScope,CSF);
		InhList ->
		   %io:format(" 7"),
		    getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList)
	    end;
	[[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt
	   %io:format(" 3"),
	    {Module,Type};
	List -> %% Multiple branches with pragma codeopt
	   %io:format(" 4"),
	    flatten(List)
    end.


%% Special treatment when X is an operation
getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) when record(X,op)->
   %io:format(" 8"),
    case ets:match(S,{op,get_id2(X),'$1','_','_'}) of
	[] ->
	   %io:format(" 10"),
	    CleanList = remove_inherited(S,InhList),
	    getBrokerDataLoop(G,S,X,RS,CleanList,CSF);
	
	[[Scope]] ->
	   %io:format(" 11"),
	    CleanList = remove_inherited(S,InhList),
	    getBrokerDataLoop(G,S,X,RS,CleanList,CSF);
   
	[[OpScope]] ->
	   %io:format(" 12"),
	    case member([OpScope],InhList) of 
		true ->
		   %io:format(" 14"),
		    %% No inherited scopes
		    getBrokerData(G,X,RS,OpScope,CSF);	
		false ->
		   %io:format(" 15"),