ictk.erl

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

	    {NewV, Str} = get_assign(G, V, X),
	    r_emit_raw(G, X, ic_genobj:stubfiled(G), Str, 
		       C, get_thing_name(X), V, 
		       get_IR_ID(G, N, X), get_id2(X), get_IR_VSN(G, N, X), 
		       F, A),
	    NewV
    end.


%%--------------------------------------------------------------------
%%
%% An IFR register line registers an entity (Thing) into the IFR. The
%% thing is registered INTO something, an type is registered into a
%% module for instance, and this is reflected in the Var parameter
%% below. The var parameter is the name of the parent IFR object. The
%% Thing parameter is the name of the thing we're trying to register,
%% a typdef is called an alias and an interface is called an
%% interface. Sometimes we need to store the thing we're registering
%% into a variable because we're going to add other things to it
%% later, modules and interfaces are such containers, so we must
%% remember that variable for later use.
%%
%% All parameters shall be strings unless otherwise noted
%%
%% Fd		- File descriptor
%% AssignStr	- Assign or not, empty except for interfaces and modules
%% Create	- Create has diff. names dep. on into what we register
%% Thing	- WHAT is registered, interface
%% Var		- The name of the variable we register into
%% IR_ID	- The IFR identifier (may be "")
%% Id		- The identifier (name) of the object
%% IR_VSN	- The IFR version as a string
%% AuxStr	- An auxillary string
%%
%%r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN) ->
%%    r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, "", []).
r_emit_raw(_G, X, Fd, AssignStr, "Repository_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) 
  when record(X, module) ->
    emit(Fd, "~n    ~s~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", 
	 [AssignStr, to_atom("oe_get_top_"++Thing), Var, IR_ID, Id, 
	  IR_VSN, io_lib:format(F, A)]);
r_emit_raw(G, X, Fd, AssignStr, "ModuleDef_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) 
  when record(X, module) ->
    emit(Fd, "~n    ~s~p(~s, ~s, \"~s\", \"~s\", \"~s\"~s),~n", 
	 [AssignStr, to_atom("oe_get_"++Thing), ?IFRID(G), Var, IR_ID, Id, 
	  IR_VSN, io_lib:format(F, A)]);
r_emit_raw(_G, _X, Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, F, A) ->
    emit(Fd, "~n    ~s~p:~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", 
	 [AssignStr, ?IFRMOD, to_atom(Create++Thing), Var, IR_ID, Id, 
	  IR_VSN, io_lib:format(F, A)]).

			 


%% Used by r_emit. Returns tuple {Var, Str} where Var is the resulting
%% output var (if any, otherwise same as input arg) and Str is a
%% string of the assignment if any ("" or "Var = ")
get_assign(G, _V, X) when record(X, module) ->
    mk_assign(G);
get_assign(G, _V, X) when record(X, interface) ->
    mk_assign(G);
get_assign(_G, V, _X) -> {V, ""}.
mk_assign(G) ->
    V = new_var(G),
    {V, io_lib:format("~s = ", [V])}.

%% Returns a list of strings of all enum members (suitable for ~p)
get_enum_member_list(_G, _S, _N, L) ->
    lists:map(fun(M) -> get_id2(M) end, L).

%% Will output a string of the union members.
get_union_member_def(_G, _S, _N, []) -> [];
get_union_member_def(G, S, N, L) ->
    [union_member2str(G, S, N, hd(L)) | 
     lists:map(fun(M) -> [", ", union_member2str(G, S, N, M)] end, tl(L))].
%%    lists:foldl(fun(M, Acc) -> 
%%			[union_member2str(G, S, N, M),", " | Acc] end,
%%		union_member2str(G, S, N, hd(L)), tl(L)).

union_member2str(G, S, N, {Label, Name, TK}) ->
    io_lib:format("~s{name=~p, label=~p, type=~p, type_def=~s}",
		  ["#unionmember", Name, Label, TK, 
		   get_idltype_tk(G, S, N, TK)]).


%% Will output a string of the struct members. Works for exceptions
%% and structs
%%
get_member_def(_G, _S, _N, []) -> [];
get_member_def(G, S, N, L) ->
    [member2str(G, S, N, hd(L)) | 
     lists:map(fun(M) -> [", ", member2str(G, S, N, M)] end, tl(L))].

member2str(G, S, N, {Id, TK}) ->
    io_lib:format("~s{name=~p, type=~p, type_def=~s}",
		  ["#structmember", Id, TK, get_idltype_tk(G, S, N, TK)]).

%% Translates between record names and create operation names. 
get_thing_name(X) when record(X, op) -> "operation";
get_thing_name(X) when record(X, const) -> "constant";
get_thing_name(X) when record(X, typedef) -> "alias";
get_thing_name(X) when record(X, attr) -> "attribute";
get_thing_name(X) when record(X, except) -> "exception";
get_thing_name(X) when record(X, id_of) -> get_thing_name(X#id_of.type);
get_thing_name(X) -> to_list(element(1,X)).


%% Returns the mode (in, out, oneway etc) of ops and params. Return
%% value is an atom.
get_mode(_G, _N, X) when record(X, op) ->
    case X#op.oneway of
	{oneway, _} -> 'OP_ONEWAY';
	_ -> 'OP_NORMAL'
    end;
get_mode(_G, _N, X) when record(X, attr) ->
    case X#attr.readonly of
	{readonly, _} -> 'ATTR_READONLY';
	_ -> 'ATTR_NORMAL'
    end;
get_mode(_G, _N, X) when record(X, param) ->
    case X#param.inout of
	{in, _} -> 'PARAM_IN';
	{inout, _} -> 'PARAM_INOUT';
	{out, _} -> 'PARAM_OUT'
    end.


%% Returns a string form of idltype creation.
%%get_idltype_id(G, S, N, X, Id) ->
%%    TK = ictype:tk_lookup(G, S, N, Id),
%%    get_idltype_tk(G, S, N, TK).
get_idltype(G, S, N, X) ->
    get_idltype_tk(G, S, N, ic_forms:get_tk(X)).
get_idltype_tk(G, _S, _N, TK) ->
    io_lib:format("~p:~p(~s, ~p)", [orber_ifr, 'Repository_create_idltype',
				    ?IFRID(G), TK]).

%% Returns a string form of typecode creation. This shall be found in
%% the type code symbol table.
%%get_typecode(G, S, N, X) -> typecode.
%%get_typecode(G, S, N, X) -> tk(G, S, N, get_type(X)).


%% Returns the string form of a list of parameters.
get_params(_G, _S, _N, []) ->  "";
get_params(G, S, N, L) -> 
    lists:foldl(fun(X, Acc) -> param2str(G, S, N, X)++", "++Acc end,
		param2str(G, S, N, hd(L)), tl(L)).


%% Converts a parameter to a string.
param2str(G, S, N, X) ->
    io_lib:format("~s{name=~p, type=~p, type_def=~s, mode=~p}~n", 
		  ["#parameterdescription", get_id2(X),
		   ic_forms:get_tk(X),
		   %%tk_lookup(G, S, N, get_type(X)),
		   get_idltype(G, S, N, X),
		   get_mode(G, N, X)]).




%% Public interface. Returns the IFR ID of an object. This
%% is updated to comply with CORBA 2.0 pragma directives.
get_IR_ID(G, N, X) ->
    ScopedId = [get_id2(X) | N],
    case ic_pragma:get_alias(G,ScopedId) of
	none ->
	    case ic_pragma:pragma_id(G, N, X) of
		none ->
		    case ic_pragma:pragma_prefix(G, N, X) of
			none ->
			    IR_ID = lists:flatten(
				      io_lib:format("IDL:~s:~s", 
						    [slashify(ScopedId), 
						     get_IR_VSN(G, N, X)])),
			    ic_pragma:mk_alias(G,IR_ID,ScopedId),
			    IR_ID;
			PF ->
			    IR_ID = lists:flatten(
				      io_lib:format("IDL:~s:~s", 
						    [ PF ++ "/" ++
						      get_id2(X),
						      get_IR_VSN(G, N, X)])),
			    ic_pragma:mk_alias(G,IR_ID,ScopedId),
			    IR_ID
		    end;
		PI ->
		    ic_pragma:mk_alias(G,PI,ScopedId),
		    PI
	    end;
	Alias ->
	    Alias
    end.

    
%% Public interface. Returns the IFR Version of an object. This
%% is updated to comply with CORBA 2.0 pragma directives.
get_IR_VSN(G, N, X) ->
    ic_pragma:pragma_version(G,N,X).
    




%% Returns a slashified name, [I1, M1] becomes "M1/I1"
%slashify(List) -> lists:foldl(fun(X, Acc) -> get_id2(X)++"/"++Acc end, 
%			      hd(List), tl(List)).

%% Returns a slashified name, [I1, M1] becomes "M1/I1"
slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, 
			      hd(List), tl(List)).


%% Returns the context literals of an op
get_context(_G, _S, _N, X) -> 
    lists:map(fun(C) -> element(3, C) end, X#op.ctx).



%% Returns the list of the exceptions of an operation
get_exceptions(G, S, N, X) -> 
    case X#op.raises of
	[] ->
	    "";
	L ->
	    lists:flatten(
	      lists:foldl( 
		fun(E, Acc) -> [excdef(G, S, N, X, E), ", " | Acc] end, 
		excdef(G, S, N, X, hd(L)), 
		tl(L)
	       )
	     )
    end.


%% Returns the definition of an exception of an operation
excdef(G, S, N, X, L) ->
    io_lib:format("orber_ifr:lookup_id(~s,\"~s\")",
		  [ ?IFRID(G),
		   get_EXC_ID(G, S, N, X, L) ] ).






%% This function produces code for the exception registration.
%% It produces a string that represents a list of function calls.
%% This list becomes a list of object references when the main function
%% "orber_ifr:InterfaceDef_create_operation" is called.

get_EXC_ID(G, _S, N, X, ScopedId) ->
    case ic_pragma:get_alias(G,ScopedId) of
	none ->
	    case ic_pragma:pragma_id(G, N, X) of
		none ->
		    case ic_pragma:pragma_prefix(G, N, X) of
			none ->
			    EXC_ID = lists:flatten(
				       io_lib:format("IDL:~s:~s", [slashify(ScopedId), 
								   get_IR_VSN(G, N, X)])),
			    ic_pragma:mk_alias(G,EXC_ID,ScopedId),
			    EXC_ID;
			PF ->
			    EXC_ID = lists:flatten(
				       io_lib:format("IDL:~s:~s", [ PF ++ "/" ++ 
								    hd(ScopedId),
								    get_IR_VSN(G, N, X)])),
			    ic_pragma:mk_alias(G,EXC_ID,ScopedId),
			    EXC_ID
		    end;
		PI ->
		    ic_pragma:mk_alias(G,PI,ScopedId),
		    PI
	    end;
	Alias ->
	    Alias
    end.





%% unreg_gen/1 uses the information stored in pragma table
%% to decide which modules are to be unregistered
unreg_gen(G, N, X) ->
    Light = ic_options:get_opt(G, light_ifr),
    case ic_genobj:is_stubfile_open(G) of
	true when Light == false ->
	    Var = ?IFRID(G),
	    Fd = ic_genobj:stubfiled(G),
	    nl(Fd), nl(Fd), nl(Fd),
	    emit(Fd, "~p() ->\n", [to_atom(unregister_name(G))]),
	    emit(Fd, "    ~s = ~p:find_repository(),\n",
		 [Var, ?IFRMOD]),
	    nl(Fd),

	    unreg2(G, N, X),
	    emit(Fd, "    ok.\n\n"),
	    destroy(Fd);
	true ->
	    Fd = ic_genobj:stubfiled(G),
	    nl(Fd), nl(Fd),
	    Unregname = to_atom(unregister_name(G)),
	    emit(Fd, "~p() ->\n\t~p([]).\n\n~p(OE_Options) ->\n", 
		 [Unregname, Unregname, Unregname]),
	    emit(Fd, "\t~p:remove(?MODULE, OE_Options),\n\tok.\n\n", [?IFRMOD]);
	false -> ok
    end.


destroy(Fd) ->
emit(Fd,"
oe_destroy_if_empty(OE_IFR,IFR_ID) ->
    case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of
	[] ->
	    ok;
	Ref ->
	    case orber_ifr:contents(Ref, \'dk_All\', \'true\') of
		[] ->
		    orber_ifr:destroy(Ref),
		    ok;
		_ ->
		    ok
	    end
    end.

oe_destroy(OE_IFR,IFR_ID) ->
    case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of
	[] ->
	    ok;
	Ref ->
	    orber_ifr:destroy(Ref),
	    ok
    end.

",[]).










%% unreg2 is top level registration 

unreg2(G, N, X) ->
    emit(ic_genobj:stubfiled(G),"~s",[lists:flatten(unreg3(G, N, X))]).

unreg3(G, N, X)  when list(X) -> 
    unreg3_list(G, N, X, []);

unreg3(G, N, X) when record(X, module) ->
    unreg3_list(G, [get_id2(X) | N], get_body(X), [unreg_collect(G, N, X)]);

unreg3(G, N, X) when record(X, const) ->
    unreg_collect(G, N, X);

unreg3(G, N, X) when record(X, struct) ->
    unreg_collect(G, N, X);

unreg3(G, N, X) when record(X, except) ->
    unreg_collect(G, N, X);

unreg3(G, N, X) when record(X, union) ->
    unreg_collect(G, N, X);

unreg3(G, N, X) when record(X, enum) ->
    unreg_collect(G, N, X);

unreg3(G, N, X) when record(X, typedef) ->
    unreg_collect(G, N, X);

unreg3(G, N, X) when record(X, interface) ->
    unreg_collect(G, N, X);

unreg3(_G, _N, X) when record(X, op) -> [];

unreg3(_G, _N, X) when record(X, attr) -> [];

unreg3(_G, _N, X)  when record(X, preproc) -> [];

unreg3(_G, _N, X)  when record(X, pragma) -> [];

unreg3(_G, _N, _X) ->  [].


unreg3_list(_G, _N, [], Found) -> 
    Found;
unreg3_list(G, N, List, Found) ->
    CurrentFileName = ic_genobj:idlfile(G), 
    unreg3_list(G, N, {CurrentFileName,true}, List, Found).

%% The filter function + loop 
unreg3_list(_G, _N, {_CFN, _Status}, [], Found) -> 
    Found;
unreg3_list(G, N, {CFN,Status}, [X | Xs], Found) ->
    case Status of 
	true ->
	    case X of
		{preproc,_,{_,_,_FileName},[{_,_,"1"}]} ->
		    unreg3_list(G, N, {CFN,false}, Xs, Found);
		_ ->
		    unreg3_list(G, N, {CFN,Status}, Xs, [unreg3(G, N, X) | Found])
	    end;
	false ->
	    case X of
		{preproc,_,{_,_,CFN},[{_,_,"2"}]} ->
		    unreg3_list(G, N, {CFN,true}, Xs,[unreg3(G, N, X) | Found]);
		_ ->
		    unreg3_list(G, N, {CFN,Status}, Xs, Found)
	    end
    end.



unreg_collect(G, N, X) when record(X, module) ->
    io_lib:format("    oe_destroy_if_empty(OE_IFR, ~p),\n", 
	      [get_IR_ID(G, N, X)]);
unreg_collect(G, N, X) when record(X, typedef) ->
    lists:map(fun(Id) ->
		      io_lib:format("    oe_destroy(OE_IFR, ~p),\n", 
				    [get_IR_ID(G, N, Id)])
		  end,
	      ic_forms:get_idlist(X));
unreg_collect(G, N, X) ->
    io_lib:format("    oe_destroy(OE_IFR, ~p),\n", 
	      [get_IR_ID(G, N, X)]).