%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1997-2009. All Rights Reserved. %% %% 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 online 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. %% %% %CopyrightEnd% %% %% -module(ictk). %% Toplevel generation functions -export([reg_gen/3, unreg_gen/3]). %% Utilities -export([get_IR_ID/3, get_IR_VSN/3, register_name/1, unregister_name/1]). -import(ic_forms, [get_id2/1, get_body/1, get_idlist/1]). -import(ic_util, [mk_name/2, mk_oe_name/2, to_atom/1, to_list/1]). -import(ic_codegen, [emit/2, emit/3, nl/1]). -include("icforms.hrl"). -include("ic.hrl"). %%-------------------------------------------------------------------- %% %% IFR Registration Generation %% %% %%-------------------------------------------------------------------- -define(IFRID(G), mk_name(G, "IFR")). -define(VARID(G), mk_name(G, "VAR")). -define(IFRMOD, orber_ifr). reg_gen(G, N, X) -> S = ic_genobj:tktab(G), Light = ic_options:get_opt(G, light_ifr), init_var(), 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(register_name(G))]), emit(Fd, " ~s = ~p:find_repository(),\n", [Var, ?IFRMOD]), nl(Fd), %% Write call function that checks if included %% modules and interfaces are created. emit(Fd, " register_tests(~s),\n",[?IFRID(G)]), reg2(G, S, N, Var, X), nl(Fd), emit(Fd, " ok.\n"), %% Write general register test function. register_tests(Fd,G), %% Write functopn that registers modules only if %% they are not registered. register_if_unregistered(Fd); true when Light == true -> Fd = ic_genobj:stubfiled(G), nl(Fd), nl(Fd), nl(Fd), Regname = to_atom(register_name(G)), emit(Fd, "~p() ->\n\t~p([]).\n\n", [Regname, Regname]), emit(Fd, "~p(OE_Options) ->\n\t~p:add_items(?MODULE, OE_Options,\n\t[", [Regname, ?IFRMOD]), reg_light(G, N, X), emit(Fd, "ok]),\n\tok.\n"); false -> ok end. reg_light(G, N, X) when is_list(X) -> reg_light_list(G, N, X); reg_light(G, N, X) when is_record(X, module) -> reg_light_list(G, [get_id2(X) | N], get_body(X)); reg_light(G, N, X) when is_record(X, struct) -> emit(ic_genobj:stubfiled(G), "{~p, ~p, struct},\n\t", [get_IR_ID(G, N, X), get_module(X, N)]); reg_light(G, N, X) when is_record(X, except) -> emit(ic_genobj:stubfiled(G), "{~p, ~p, except},\n\t", [get_IR_ID(G, N, X), get_module(X, N)]); reg_light(G, N, X) when is_record(X, union) -> emit(ic_genobj:stubfiled(G), "{~p, ~p, union},\n\t", [get_IR_ID(G, N, X), get_module(X, N)]); reg_light(G, N, X) when is_record(X, interface) -> emit(ic_genobj:stubfiled(G), "{~p, ~p, interface},\n\t", [get_IR_ID(G, N, X), get_module(X, N)]), reg_light_list(G, [get_id2(X)|N], get_body(X)); reg_light(_G, _N, _X) -> ok. get_module(X, N) -> List = [get_id2(X) | N], list_to_atom(lists:foldl(fun(E, Acc) -> E++"_"++Acc end, hd(List), tl(List))). %% This function filters off all "#include .idl" code that %% come along from preprocessor and scanner. Produces code ONLY for %% the actuall file. See ticket OTP-2133 reg_light_list(_G, _N, []) -> []; reg_light_list(G, N, List ) -> CurrentFileName = ic_genobj:idlfile(G), reg_light_list(G, N, {CurrentFileName,true}, List). %% The filter function + loop reg_light_list(_G, _N, {_CFN, _Status}, []) -> []; reg_light_list(G, N, {CFN,Status}, [X | Xs]) -> case Status of true -> case X of {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> reg_light_list(G, N, {CFN,false}, Xs); _ -> reg_light(G, N, X), reg_light_list(G, N, {CFN,Status}, Xs) end; false -> case X of {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> reg_light(G, N, X), reg_light_list(G, N, {CFN,true}, Xs); _ -> reg_light_list(G, N, {CFN,Status}, Xs) end end. %% reg2 is top level registration reg2(G, S, N, Var, X) -> reg2(G, S, N, "Repository_create_", Var, X). reg2(G, S, N, C, V, X) when is_list(X) -> reg2_list(G, S, N, C, V, X); reg2(G, S, N, C, V, X) when is_record(X, module) -> NewV = r_emit2(G, S, N, C, V, X, "", []), reg2_list(G, S, [get_id2(X) | N], "ModuleDef_create_", NewV, get_body(X)); reg2(G, S, N, C, V, X) when is_record(X, const) -> r_emit2(G, S, N, C, V, X, ", ~s, ~p", [get_idltype(G, S, N, X), {X#const.tk, X#const.val}]); reg2(G, S, N, C, V, X) when is_record(X, struct) -> do_struct(G, S, N, C, V, X, ic_forms:get_tk(X)); reg2(G, S, N, C, V, X) when is_record(X, except) -> do_except(G, S, N, C, V, X, ic_forms:get_tk(X)); reg2(G, S, N, C, V, X) when is_record(X, union) -> do_union(G, S, N, C, V, X, ic_forms:get_tk(X)); reg2(G, S, N, C, V, X) when is_record(X, enum) -> r_emit2(G, S, N, C, V, X, ", ~p", [get_enum_member_list(G, S, N, get_body(X))]); reg2(G, S, N, C, V, X) when is_record(X, typedef) -> do_typedef(G, S, N, C, V, X), look_for_types(G, S, N, C, V, get_body(X)); reg2(G, S, N, C, V, X) when is_record(X, attr) -> XX = #id_of{type=X}, lists:foreach(fun(Id) -> r_emit2(G, S, N, C, V, XX#id_of{id=Id}, ", ~s, ~p", [get_idltype(G, S, N, X), get_mode(G, N, X)]) end, get_idlist(X)); reg2(G, S, N, C, V, X) when is_record(X, interface) -> N2 = [get_id2(X) | N], Body = get_body(X), BIs = get_base_interfaces(G,X), %% produce code for the interface inheritance NewV = r_emit2(G, S, N, C, V, X, ", " ++ BIs,[]), reg2_list(G, S, N2, "InterfaceDef_create_", NewV, Body); reg2(G, S, N, C, V, X) when is_record(X, op) -> r_emit2(G, S, N, C, V, X, ", ~s, ~p, [~s], [~s], ~p", [get_idltype(G, S, N, X), get_mode(G, N, X), get_params(G, S, N, X#op.params), get_exceptions(G, S, N, X), get_context(G, S, N, X)]); reg2(_G, _S, _N, _C, _V, X) when is_record(X, preproc) -> ok; reg2(_G, _S, _N, _C, _V, X) when is_record(X, pragma) -> ok; reg2(_G, _S, _N, _C, _V, _X) -> ok. %% This function filters off all "#include .idl" code that %% come along from preprocessor and scanner. Produces code ONLY for %% the actuall file. See ticket OTP-2133 reg2_list(_G, _S, _N, _C, _V, []) -> []; reg2_list(G, S, N, C, V, List ) -> CurrentFileName = ic_genobj:idlfile(G), reg2_list(G, S, N, C, V, {CurrentFileName,true}, List). %% The filter function + loop reg2_list(_G, _S, _N, _C, _V, {_CFN, _Status}, []) -> []; reg2_list(G, S, N, C, V, {CFN,Status}, [X | Xs]) -> case Status of true -> case X of {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> reg2_list(G, S, N, C, V, {CFN,false}, Xs); _ -> F = reg2(G, S, N, C, V, X), [F | reg2_list(G, S, N, C, V, {CFN,Status}, Xs)] end; false -> case X of {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> F = reg2(G, S, N, C, V, X), [F | reg2_list(G, S, N, C, V, {CFN,true}, Xs)]; _ -> reg2_list(G, S, N, C, V, {CFN,Status}, Xs) end end. %% General registration tests register_tests(Fd,G) -> IfrId = ?IFRID(G), emit(Fd,"\n\n%% General IFR registration checks.\n", []), emit(Fd,"register_tests(~s)->\n",[IfrId]), emit(Fd," re_register_test(~s),\n",[IfrId]), emit(Fd," include_reg_test(~s).\n\n",[IfrId]), emit(Fd,"\n%% IFR type Re-registration checks.\n", []), case ic_pragma:fetchRandomLocalType(G) of {ok,TypeId} -> emit(Fd,"re_register_test(~s)->\n",[IfrId]), emit(Fd," case orber_ifr:'Repository_lookup_id'(~s,~p) of\n", [IfrId,TypeId]), emit(Fd," [] ->\n true;\n",[]), emit(Fd," _ ->\n exit({allready_registered,~p})\n end.\n\n", [TypeId]); false -> emit(Fd,"re_register_test(_)-> true.\n",[]) end, emit(Fd,"~s",[check_include_regs(G)]). %% This function produces code for existance check over %% top level included modules and interfaces check_include_regs(G) -> IfrId = ?IFRID(G), case ic_pragma:get_incl_refs(G) of none -> io_lib:format("\n%% No included idl-files detected.\n", []) ++ io_lib:format("include_reg_test(_~s) -> true.\n",[IfrId]); IMs -> io_lib:format("\n%% IFR registration checks for included idl files.\n", []) ++ io_lib:format("include_reg_test(~s) ->\n",[IfrId]) ++ check_incl_refs(G,IfrId,IMs) end. check_incl_refs(_,_,[]) -> io_lib:format(" true.\n",[]); check_incl_refs(G,IfrId,[[First]|Rest]) -> ModId = ic_pragma:scope2id(G,First), io_lib:format(" case orber_ifr:'Repository_lookup_id'(~s,~p) of~n", [IfrId,ModId]) ++ io_lib:format(" [] ->~n exit({unregistered,~p});~n", [ModId]) ++ io_lib:format(" _ ->~n true~n end,~n",[]) ++ check_incl_refs(G,IfrId,Rest). %% This function will return module ref, it will %% also register module if not registered. register_if_unregistered(Fd) -> emit(Fd, "\n\n%% Fetch top module reference, register if unregistered.\n"), emit(Fd, "oe_get_top_module(OE_IFR, ID, Name, Version) ->\n"), emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), emit(Fd, " [] ->\n"), emit(Fd, " orber_ifr:'Repository_create_module'(OE_IFR, ID, Name, Version);\n"), emit(Fd, " Mod ->\n"), emit(Fd, " Mod\n",[]), emit(Fd, " end.\n\n"), emit(Fd, "%% Fetch module reference, register if unregistered.\n"), emit(Fd, "oe_get_module(OE_IFR, OE_Parent, ID, Name, Version) ->\n"), emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), emit(Fd, " [] ->\n"), emit(Fd, " orber_ifr:'ModuleDef_create_module'(OE_Parent, ID, Name, Version);\n"), emit(Fd, " Mod ->\n"), emit(Fd, " Mod\n",[]), emit(Fd, " end.\n"). do_typedef(G, S, N, C, V, X) -> case ic_genobj:is_stubfile_open(G) of false -> ok; true -> Fd = ic_genobj:stubfiled(G), Thing = get_thing_name(X), IR_VSN = get_IR_VSN(G, N, X), TK = ic_forms:get_tk(X), lists:foreach( fun(Id) -> r_emit_raw(G, X, Fd, "", C, Thing, V, get_IR_ID(G, N, Id), get_id2(Id), IR_VSN, ", ~s", [get_idltype_tk(G, S, N, ictype:maybe_array(G, S, N, Id, TK))]) end, get_idlist(X)) end. do_union(G, S, N, C, V, X, {tk_union, _IFRID, _Name, DiscrTK, _DefNr, L}) -> N2 = [get_id2(X) | N], r_emit2(G, S, N, C, V, X, ", ~s, [~s]", [get_idltype_tk(G, S, N, DiscrTK), get_union_member_def(G, S, N2, L)]), look_for_types(G, S, N2, C, V, get_body(X)). do_struct(G, S, N, C, V, X, {tk_struct, _IFRID, _Name, ElemList}) -> N2 = [get_id2(X) | N], r_emit2(G, S, N, C, V, X, ", [~s]", [get_member_def(G, S, N, ElemList)]), look_for_types(G, S, N2, C, V, get_body(X)). do_except(G, S, N, C, V, X, {tk_except, _IFRID, _Name, ElemList}) -> N2 = [get_id2(X) | N], r_emit2(G, S, N, C, V, X, ", [~s]", [get_member_def(G, S, N, ElemList)]), look_for_types(G, S, N2, C, V, get_body(X)). %% new_var finds an unused Erlang variable name by increasing a %% counter. new_var(_G) -> lists:flatten(["_OE_", integer_to_list(put(var_count, get(var_count) + 1))]). init_var() -> put(var_count, 1). %% Public interface. The name of the register function. register_name(G) -> mk_oe_name(G, "register"). unregister_name(G) -> mk_oe_name(G, "unregister"). look_for_types(G, S, N, C, V, L) when is_list(L) -> lists:foreach(fun(X) -> look_for_types(G, S, N, C, V, X) end, L); look_for_types(G, S, N, C, V, {_Name, TK}) -> % member look_for_types(G, S, N, C, V, TK); look_for_types(_G, _S, _N, _C, _V, {tk_union, _IFRID, _Name, _DT, _Def, _L}) -> ok; look_for_types(G, S, N, C, V, {_Label, _Name, TK}) -> % case_dcl look_for_types(G, S, N, C, V, TK); look_for_types(_G, _S, _N, _C, _V, {tk_struct, _IFRID, _Name, _L}) -> ok; look_for_types(_G, _S, _N, _C, _V, _X) -> ok. %% This function produces code for the interface inheritance 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:ModuleDef_create_interface" is called. get_base_interfaces(G,X) -> case element(3,X) of [] -> "[]"; L -> "[" ++ lists:flatten( lists:foldl( fun(E, Acc) -> [call_fun_str(G,E), ", " | Acc] end, call_fun_str(G,hd(L)), tl(L) ) ) ++ "]" end. call_fun_str(G,S) -> lists:flatten( io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", [ ?IFRID(G), ic_pragma:scope2id(G,S)] )). %%-------------------------------------------------------------------- %% %% r_emit emits an IFR register function call. It returns a new %% variable (if further defs should be added to that one) %% %% G is genobj %% %% S is symbol table (ets) %% %% N is list of ids describing scope %% %% C is create stub (eg. "Repository_create_") %% %% V is variable name where current def should be added, %% %% X is the current def item, %% %% F and A is auxillary format and args that will be io_lib %% formatted and inserted as a string (don't forget to start with %% ", ") %% r_emit2(G, _S, N, C, V, X, F, A) -> case ic_genobj:is_stubfile_open(G) of false -> ok; true -> {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 is_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 is_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 is_record(X, module) -> mk_assign(G); get_assign(G, _V, X) when is_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 is_record(X, op) -> "operation"; get_thing_name(X) when is_record(X, const) -> "constant"; get_thing_name(X) when is_record(X, typedef) -> "alias"; get_thing_name(X) when is_record(X, attr) -> "attribute"; get_thing_name(X) when is_record(X, except) -> "exception"; get_thing_name(X) when is_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 is_record(X, op) -> case X#op.oneway of {oneway, _} -> 'OP_ONEWAY'; _ -> 'OP_NORMAL' end; get_mode(_G, _N, X) when is_record(X, attr) -> case X#attr.readonly of {readonly, _} -> 'ATTR_READONLY'; _ -> 'ATTR_NORMAL' end; get_mode(_G, _N, X) when is_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 is_list(X) -> unreg3_list(G, N, X, []); unreg3(G, N, X) when is_record(X, module) -> unreg3_list(G, [get_id2(X) | N], get_body(X), [unreg_collect(G, N, X)]); unreg3(G, N, X) when is_record(X, const) -> unreg_collect(G, N, X); unreg3(G, N, X) when is_record(X, struct) -> unreg_collect(G, N, X); unreg3(G, N, X) when is_record(X, except) -> unreg_collect(G, N, X); unreg3(G, N, X) when is_record(X, union) -> unreg_collect(G, N, X); unreg3(G, N, X) when is_record(X, enum) -> unreg_collect(G, N, X); unreg3(G, N, X) when is_record(X, typedef) -> unreg_collect(G, N, X); unreg3(G, N, X) when is_record(X, interface) -> unreg_collect(G, N, X); unreg3(_G, _N, X) when is_record(X, op) -> []; unreg3(_G, _N, X) when is_record(X, attr) -> []; unreg3(_G, _N, X) when is_record(X, preproc) -> []; unreg3(_G, _N, X) when is_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 is_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 is_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)]).