ic_noc.erl

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

			    _ ->             [{Get, 1}, {Set, 2} | Acc2]
			end end, Acc, ic_forms:get_idlist(A));

exp3(_G, _N, _X, _NT, Acc) -> Acc.

exp_list(G, N, L, NT, OrigAcc) -> 
    lists:foldr(fun(X, Acc) -> exp3(G, N, X, NT, Acc) end, OrigAcc, L).




%%------------------------------------------------------------
%%
%% Emit stuff
%%
%%	Low level generation primitives
%%

emit_stub_func(G, N, X, Name, ArgNames, TypeList, _OutArgs) ->
    case ic_genobj:is_stubfile_open(G) of
	false -> ok;
	true ->
	    Fd = ic_genobj:stubfiled(G),
	    StubName = list_to_atom(Name),
	    This = mk_name(G, "Ref"),
	    XTuple = getNocType(G,X,N),
	    CallOrCast = 
		case is_oneway(X) of 
		    true -> ?CAST; 
		    _ -> ?CALL
		end,

	    %% Type expand operation on comments
	    ic_code:type_expand_op(G,N,X,Fd),

	    case use_timeout(G,N,X) of
		true ->
		    Timeout = mk_name(G,"Timeout"),
		    emit(Fd, "~p(~s) ->\n", 
			 [StubName, mk_list([This, Timeout| ArgNames])]),
		    emit(Fd, "    ~p:~s(~s, ~s, ?MODULE, ~p, ~p, [~s], ~p).\n\n", 
			 [getImplMod(G,X,N), 
			  CallOrCast, 
			  This, 
			  Timeout, 
			  XTuple, 
			  StubName, 
			  mk_list(ArgNames), 
			  tk_operation_data(G, N, X, TypeList)]);
		false ->
		    emit(Fd, "~p(~s) ->\n", 
			 [StubName, mk_list([This | ArgNames])]),
		    
		    emit(Fd, "    ~p:~s(~s, ~p, ?MODULE, ~p, [~s], ~p).\n\n", 
			 [getImplMod(G,X,N), 
			  CallOrCast, 
			  This, 
			  XTuple, 
			  StubName, 
			  mk_list(ArgNames), 
			  tk_operation_data(G, N, X, TypeList)])
	    end
    end.


emit_transparent_func(G, N, X, Name, ArgNames, _TypeList, _OutArgs) ->
    case ic_genobj:is_stubfile_open(G) of
	false -> ok;
	true ->
	    Fd = ic_genobj:stubfiled(G),
	    OpName = list_to_atom(Name),
	    
	    ArgList = case use_timeout(G,N,X) of
			  true ->
			      mk_list([mk_name(G,"Ref"),mk_name(G,"Timeout")|ArgNames]);
			  false ->
			       mk_list([mk_name(G,"Ref")|ArgNames])
		      end,

	    %% Type expand operation on comments
	    ic_code:type_expand_op(G,N,X,Fd),

	    emit(Fd, "~p(~s) ->\n", [OpName,ArgList]),
	    emit(Fd, "    ~p:~s(~s).\n\n", [getImplMod(G,X,N), OpName, ArgList])
    end.






emit_skel_func(G, N, X, OpName, ArgNames, _TypeList, _OutArgs) ->
    case getNocType(G,X,N) of
	transparent ->
	    true;
	multiple ->
	    true;
	XTuple ->
	    case ic_genobj:is_stubfile_open(G) of
		false -> ok;
		true ->
		    Fd = ic_genobj:stubfiled(G),
		    Name	= list_to_atom(OpName),
		    This	= mk_name(G, "Ref"),
		    From	= mk_name(G, "From"),
		    State	= mk_name(G, "State"),
		    
		    %% Type expand handle operation on comments
		    ic_code:type_expand_handle_op(G,N,X,Fd),

		    case is_oneway(X) of
			true ->
			    emit(Fd, "handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s) ->\n",
				 [This, XTuple, Name, mk_list(ArgNames), State]),
			    emit(Fd, "    ~p:handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s);\n\n", 
				 [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), State]);
			false ->
			    emit(Fd, "handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s) ->\n",
				 [This, XTuple, Name, mk_list(ArgNames), From, State]),
			    emit(Fd, "    ~p:handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s);\n\n", 
				 [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), From, State])
		    end
	    end
    end.



emit_constant_func(G, Id, Val) ->
    case ic_genobj:is_stubfile_open(G) of
	false -> ok;
	true ->
	    Fd = ic_genobj:stubfiled(G),
	    N = list_to_atom(get_id(Id)),
	    emit_const_comment(G, Fd, Id, N),
	    emit(Fd, "~p() -> ~p.\n\n", [N, Val])
    end.


emit_const_comment(_G, F, _X, Name) ->
    ic_codegen:mcomment_light(F,
			 [io_lib:format("Constant: ~p", [Name])]).

%%------------------------------------------------------------
%%
%% Utilities
%%
%% Convenient little go-get functions
%%
%%------------------------------------------------------------

%% The automaticly generated get and set operation names for an
%% attribute.
mk_attr_func_names(_Scope, Name) ->
    {"_get_" ++ Name, "_set_" ++ Name}.

%% Returns TK of the Get and Set attribute functions.
mk_attr_func_types(_N, X) ->
    TK = ic_forms:get_tk(X),
    {{TK, [], []}, {tk_void, [TK], []}}.
        


%%------------------------------------------------------------
%%
%% Generation utilities and common stuff
%%
%% Convenient stuff for generation
%%
%%------------------------------------------------------------


%% Input is a list of parameters (in parse form) and output is a list
%% of capitalised variable names. mk_var is in icgen
mk_erl_vars(_G, Params) ->
    map(fun(P) -> mk_var(get_id(P#param.id)) end, Params).


%% mk_list produces a nice comma separated string of variable names
mk_list([]) -> [];
mk_list([Arg | Args]) ->
    Arg ++ mk_list2(Args).
mk_list2([Arg | Args]) ->
    ", " ++ Arg ++ mk_list2(Args);
mk_list2([]) -> [].


%%------------------------------------------------------------
%%
%% Parser utilities
%%
%% Called from the yecc parser. Expands the identifier list of an
%% attribute so that the attribute generator never has to handle
%% lists.
%%
%%------------------------------------------------------------


%% Unfold identifier lists or nested lists. Note that many records
%% contain an entry named id that is a list before unfold and a single
%% id afterwards.
unfold(L) when list(L) ->
    lists:flatten(map(fun(X) -> unfold2(X) end, L));
unfold(X) -> unfold2(X).
    
unfold2(A) when record(A, attr) ->
    map(fun(Id) -> A#attr{id=Id} end, A#attr.id);
unfold2(M) when record(M, member) ->
    map(fun(Id) -> M#member{id=Id} end, M#member.id);
unfold2(M) when record(M, case_dcl) ->
    map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label);
unfold2(T) when record(T, typedef) ->
    map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id   ).






%% Export code produce for dependency function
exportDependency(G) ->
    Fd = ic_genobj:stubfiled(G),
    ic_codegen:export(Fd, [{oe_dependency, 0}]),
    nl(Fd).

%% Code produce for dependency function
genDependency(G) ->
    Fd = ic_genobj:stubfiled(G),
    nl(Fd),nl(Fd),
    ic_codegen:comment(Fd, "Idl file dependency list function"), 
    emit(Fd, "oe_dependency() ->\n", []),
    emit(Fd, "    ~p.\n\n", [ic_pragma:get_dependencies(G)]).   





%%%%%%


getImplMod(G,X,Scope) -> %% to_atom(ic_genobj:impl(G)) | ChoicedModuleName

    %% Get actual pragma appliance scope
    SpecScope = getActualScope(G,X,Scope),

    %% The "broker" option is passed 
    %% only by pragmas, seek for module.
    case ic_pragma:getBrokerData(G,X,SpecScope) of
	{Module,_Type} ->
	    Module;
	_List ->
	    element(1,ic_pragma:defaultBrokerData(G))
    end.


getNocType(G,X,Scope) when record(X, interface) -> %% default | specified 
    OpList = getAllOperationScopes(G,Scope),
    getNocType2(G,X,OpList);
getNocType(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN}
    getNocType3(G,X,Scope).

getNocType2(G,X,List) ->
    getNocType2(G,X,List,[]).

getNocType2(_,_,[],Found) ->
    selectTypeFromList(Found);
getNocType2(G,X,[OpScope|OpScopes],Found) ->
    getNocType2(G,X,OpScopes,[getNocType3(G,X,OpScope)|Found]).

getNocType3(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN}

    %% Get actual pragma appliance scope
    SpecScope = getActualScope(G,X,Scope),

    %% The "broker" option is passed 
    %% only by pragmas, seek for type.
    case ic_pragma:getBrokerData(G,X,SpecScope) of
	{_Module,Type} ->
	    Type;
	List ->
	    selectTypeFromList(List) %%transparent/multiple
    end.


getModType(G,X,Scope) -> %% default | specified 

    %% Get actual pragma appliance scope
    SpecScope = getActualScope(G,X,Scope),

    %% The "broker" option is passed 
    %% only by pragmas, seek for brokerdata.
    case ic_pragma:getBrokerData(G,X,SpecScope) of
	{Module,Type} ->
	    case Module == ic_genobj:impl(G) of
		true ->
		    case Type of 
			transparent ->
			    dt; %% default + transparent
			_ ->
			    do  %% default + opaque
		    end;
		false ->
		    case Type of 
			transparent ->
			    spt; %% specified + transparent
			_ ->
			    spo  %% specified + opaque
		    end
	    end;
	_List ->
	    dt
    end.



%%%%
%%
%% Returns a list of ALL operation full 
%% scoped names local and inherited
%% from other interfaces
%%

getAllOperationScopes(G,Scope) ->
    getOperationScopes(G,Scope) ++ 
	getInhOperationScopes(G,Scope).
	

getOperationScopes(G,Scope) ->
    getOpScopes(G,
		Scope,
		ets:match(ic_genobj:pragmatab(G),{op,'$0',Scope,'_','_'}),
		[]).

getOpScopes(_,_,[],OpScopes) ->
    OpScopes;
getOpScopes(G,Scope,[[Name]|Names],Found) ->
    getOpScopes(G,Scope,Names,[[Name|Scope]|Found]).


getInhOperationScopes(G,Scope) ->
    getInhOpScopes1(G,
		   Scope,
		   ets:match(ic_genobj:pragmatab(G),{inherits,Scope,'$1'}),
		   []).

getInhOpScopes1(G,_Scope,[],OpScopes) ->
    getInhOpScopes2(G,OpScopes);
getInhOpScopes1(G,Scope,[[SC]|SCs],Found) ->
    getInhOpScopes1(G,Scope,SCs,[SC|Found]).


getInhOpScopes2(G,Scopes) ->
    getInhOpScopes2(G,Scopes,[]).

getInhOpScopes2(_G,[],Found) ->
    Found;
getInhOpScopes2(G,[SC|SCs],Found) ->
   getOperationScopes(G,SC) ++ getInhOpScopes2(G,SCs,Found).

%%
%%
%%%%



%%%%
%%
%%
%% Seek the actual operation scope :
%%
%%   * if the operation is inherited, get the real scope for it
%%
%%   * if the operation has a specific pragma, apply the real
%%     scope, otherwise return the including scope 
%%
getActualScope(G, X, Scope) when record(X, op) ->
    OpScope = getRealOpScope(G,X,Scope),
    case ets:match(ic_genobj:pragmatab(G),{codeopt_specific,OpScope}) of
	[[]] ->
	    OpScope;
	_ ->
	    Scope
    end;
getActualScope(_G, _X, N) ->
    N.

%%
%%  Just seek and return the scope for the operation
%%  where it were originaly defined
%%
getRealOpScope(G,X,N) when record(X, op) ->
    Ptab = ic_genobj:pragmatab(G),
    Id = get_id2(X),
    
    case ets:match(Ptab,{op,Id,N,'_','_'}) of
	[[]] ->
	    [Id|N];
	_ ->
	    getRealOpScope(G, Ptab, X, N, Id,  ets:match(Ptab,{inherits,N,'$1'}))
    end;
getRealOpScope(_G,_X,N) ->
    N.

getRealOpScope(_G, _S, _X, N, Id, []) ->
    [Id|N];
getRealOpScope(G, S, X, N, Id, [[OS]|OSs]) -> 
    case ets:match(S,{op,Id,OS,'_','_'}) of
	[[]] ->
	    [Id|OS];
	_ ->
	    getRealOpScope(G, S, X, N, Id, OSs)
    end.
    
selectTypeFromList([]) ->
    transparent;
selectTypeFromList([{_,transparent}|Rest]) ->
    selectTypeFromList(Rest);
selectTypeFromList([transparent|Rest]) ->
    selectTypeFromList(Rest);
selectTypeFromList([_|_Rest]) ->
    multiple.



getCallErr() ->    
    {'ERROR' ,"Bad Operation -- handle call"}.

getCastErr() ->
    {'ERROR' ,"Bad Operation -- handle cast"}.

getInfoErr() ->
    {'ERROR' ,"Bad Operation -- handle info"}.






%%
%% Type code access utilities
%%

tk_operation_data(G, N, X, TL) ->
    case print_tk(G,N,X) of
	true ->
	    TL;
	false ->
	    no_tk
    end.

tk_interface_data(G, N, X) ->
    InfoList = 
	foldr(fun({_Name, Body}, Acc) ->
		      get_if(G,N,Body)++Acc end,
	      get_if(G,N,get_body(X)),
	      X#interface.inherit_body),
    case InfoList of
	[] ->
	    no_tk;  %%%%%%%% Should be changed to [] <<<<<<<<<<<<<<<<<<<<<<<<<<< Warning !
	_ ->
	    InfoList
    end.


print_tk(G, N, X) when record(X, op)-> %% operation
    case getNocType(G,X,N) of
	transparent ->
	    false;
	multiple ->
	    false;
	_XTuple -> %%check if there are any USETK pragmas
	    operation_usetk(G,N,X)
    end; 
print_tk(_G, _N, _X) -> %% error
    false.


operation_usetk(G,N,X) ->
    PTab = ic_genobj:pragmatab(G),
    OTab = ic_genobj:optiontab(G),
    OpName = get_id2(X),
%    SID = ic_util:to_colon(N),
    Res = case use_tk(OTab,[N]) of
	      {ok,N} ->
		  true;
	      false ->
		  %% Look if there is an operation with that name
                  %% which can be found in an included file.
		  case ets:match(PTab,{file_data_included,'_','_',op,'$3',OpName,'_','_','_'}) of
		      [] ->
			  false;
		      ScopeList ->
			  case use_tk(OTab,ScopeList) of
			      %% There is an operation with that name, 
			      %% look if it is inherited by interface "N"
			      {ok,FoundScope} ->
				  ic_pragma:is_inherited_by(FoundScope,N,PTab);
			      false ->
				  false
			  end
		  end
	  end,
    Res. 


use_tk(_,[]) ->
    false;
use_tk(OTab,[[Scope]|Scopes]) ->
    SID = ic_util:to_colon(Scope),
    case ets:match(OTab,{{option,{use_tk,SID}},true}) of
	[] ->
	    case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of
		[] ->
		    use_tk(OTab,Scopes);
		_ ->
		    {ok,Scope}
	    end;
	_ ->
	    {ok,Scope}
    end;
use_tk(OTab,[Scope|Scopes]) ->
    SID = ic_util:to_colon(Scope),
    case ets:match(OTab,{{option,{use_tk,SID}},true}) of
	[] ->
	    case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of
		[] ->
		    use_tk(OTab,Scopes);
		_ ->
		    {ok,Scope}
	    end;
	_ ->
	    {ok,Scope}
    end.





mark_not_transparent(G,N) ->

    %% Mark that there are multiple 
    %% functions in interface 
    S = ic_genobj:pragmatab(G),
    ets:insert(S,{no_transparent,N}).


transparent(G) ->
    
    S = ic_genobj:pragmatab(G),
    case ets:match_object(S,{no_transparent,'$0'}) of
	[] ->
	    true;
	_ ->
	    false
    end.