%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% %% %CopyrightEnd% %% %% -module(ic_erlbe). -export([do_gen/3]). %%------------------------------------------------------------ %% %% Internal stuff %% %%------------------------------------------------------------ -export([unfold/1, mk_attr_func_names/2]). -import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). -import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]). -import(ic_codegen, [emit/2, emit/3, nl/1]). -import(ic_options, [get_opt/2]). -import(lists, [foreach/2, foldr/3, map/2]). -include("icforms.hrl"). -include("ic.hrl"). -include_lib("stdlib/include/erl_compile.hrl"). %%------------------------------------------------------------ %% %% Generate the client side Erlang stubs. %% %% Each module is generated to a separate file. %% %% Export declarations for all interface functions must be %% generated. Each function then needs to generate a function head and %% a body. IDL parameters must be converted into Erlang parameters %% (variables, capitalised) and a type signature list must be %% generated (for later encode/decode). %% %%------------------------------------------------------------ do_gen(G, File, Form) -> GT = get_opt(G, be), G2 = ic_file:filename_push(G, [], mk_oe_name(G, ic_file:remove_ext(to_list(File))), erlang), Light = ic_options:get_opt(G, light_ifr), R = if GT == erl_corba, Light == false -> case ic_genobj:is_stubfile_open(G2) of true -> emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n", [?ORBNAME, ?IFRTYPESHRL]); false -> ok end, gen_head(G2, [], Form), ic_codegen:export(ic_genobj:stubfiled(G2), [{ictk:register_name(G2), 0}, {ictk:unregister_name(G2), 0}, {oe_get_module,5}, {oe_dependency,0}]), R0= gen(G2, [], Form), ictk:reg_gen(G2, [], Form), ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3 genDependency(G2), % creates code for dependency list R0; GT == erl_corba, Light == true -> case ic_genobj:is_stubfile_open(G2) of true -> emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n", [?ORBNAME, ?IFRTYPESHRL]); false -> ok end, gen_head(G2, [], Form), ic_codegen:export(ic_genobj:stubfiled(G2), [{ictk:register_name(G2), 0}, {ictk:register_name(G2), 1}, {ictk:unregister_name(G2), 0}, {ictk:unregister_name(G2), 1}]), R0= gen(G2, [], Form), ictk:reg_gen(G2, [], Form), ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3 R0; true -> gen_head(G2, [], Form), gen(G2, [], Form) end, ic_file:filename_pop(G2, erlang), R. gen(G, N, [X|Xs]) when is_record(X, preproc) -> NewG = ic:handle_preproc(G, N, X#preproc.cat, X), gen(NewG, N, Xs); gen(G, N, [X|Xs]) when is_record(X, module) -> CD = ic_code:codeDirective(G,X), G2 = ic_file:filename_push(G, N, X, CD), N2 = [get_id2(X) | N], gen_head(G2, N2, X), gen(G2, N2, get_body(X)), G3 = ic_file:filename_pop(G2, CD), gen(G3, N, Xs); gen(G, N, [X|Xs]) when is_record(X, interface) -> G2 = ic_file:filename_push(G, N, X, erlang), N2 = [get_id2(X) | N], gen_head(G2, N2, X), gen(G2, N2, get_body(X)), foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, X#interface.inherit_body), gen_serv(G2, N, X), G3 = ic_file:filename_pop(G2, erlang), gen(G3, N, Xs); gen(G, N, [X|Xs]) when is_record(X, const) -> % N2 = [get_id2(X) | N], emit_constant_func(G, X#const.id, X#const.val), gen(G, N, Xs); %% N2 or N? gen(G, N, [X|Xs]) when is_record(X, op) -> {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs, is_oneway(X), get_opt(G, be)), gen(G, N, Xs); gen(G, N, [X|Xs]) when is_record(X, attr) -> emit_attr(G, N, X, fun emit_stub_func/9), gen(G, N, Xs); gen(G, N, [X|Xs]) when is_record(X, except) -> icstruct:except_gen(G, N, X, erlang), gen(G, N, Xs); gen(G, N, [X|Xs]) -> case may_contain_structs(X) of true -> icstruct:struct_gen(G, N, X, erlang); false -> ok end, gen(G, N, Xs); gen(_G, _N, []) -> ok. may_contain_structs(X) when is_record(X, typedef) -> true; may_contain_structs(X) when is_record(X, struct) -> true; may_contain_structs(X) when is_record(X, union) -> true; may_contain_structs(_X) -> false. %%-------------------------------------------------------------------- %% %% Generate the server side (handle_call and handle_cast) %% gen_serv(G, N, X) -> case ic_genobj:is_stubfile_open(G) of true -> GT = get_opt(G, be), gen_oe_is_a(G, N, X, GT), N2 = [get_id2(X) | N], gen_oe_tc(G, N2, X, GT), emit_serv_std(GT, G, N, X), gen_calls(G, N2, get_body(X)), lists:foreach(fun({_Name, Body}) -> gen_calls(G, N2, Body) end, X#interface.inherit_body), gen_end_of_call(GT, G), gen_casts(G, N2, get_body(X)), lists:foreach(fun({_Name, Body}) -> gen_casts(G, N2, Body) end, X#interface.inherit_body), gen_end_of_cast(GT, G), emit_skel_footer(GT, G, N, X); % Note N instead of N2 false -> ok end. gen_oe_is_a(G, N, X, erl_corba) when is_record(X, interface) -> Fd = ic_genobj:stubfiled(G), ic_codegen:mcomment(Fd, ["Inherited Interfaces"]), emit(Fd, "oe_is_a(~p) -> true;\n", [ictk:get_IR_ID(G, N, X)]), lists:foreach(fun(ScopedName) -> emit(Fd, "oe_is_a(~p) -> true;\n", [ic_pragma:scope2id(G, ScopedName)]) end, X#interface.inherit), emit(Fd, "oe_is_a(_) -> false.\n"), nl(Fd), ok; gen_oe_is_a(_G, _N, _X, _BE) -> ok. %% Generates the oe_tc function gen_oe_tc(G, N, X, erl_corba) -> Fd = ic_genobj:stubfiled(G), ic_codegen:mcomment(Fd, ["Interface TypeCode"]), LocalInterface = gen_oe_tc2(G, N, get_body(X), Fd, []), CompleteInterface = lists:foldl(fun({Name, Body}, FunAcc) -> AName = ic_util:to_atom(ic_util:to_undersc(Name)), gen_oe_tc3(G, AName, Body, Fd, FunAcc) end, LocalInterface, X#interface.inherit_body), emit(Fd, "oe_tc(_) -> undefined.\n"), nl(Fd), emit(Fd, "oe_get_interface() -> \n\t["), emit_oe_get_interface(Fd, CompleteInterface), nl(Fd), ok; gen_oe_tc(_, _, _, _) -> ok. emit_oe_get_interface(Fd, []) -> emit(Fd, "].\n"); emit_oe_get_interface(Fd, [Item]) -> emit(Fd, "~s].\n", [lists:flatten(Item)]); emit_oe_get_interface(Fd, [H|T]) -> emit(Fd, "~s,\n\t", [lists:flatten(H)]), emit_oe_get_interface(Fd, T). gen_oe_tc2(_,_,[],_, Acc) -> Acc; gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, op) -> R = ic_forms:get_tk(X), IN = lists:map(fun(P) -> ic_forms:get_tk(P) end, ic:filter_params([in, inout], X#op.params)), OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end, ic:filter_params([out, inout], X#op.params)), Function = get_id2(X), FunctionAtom = ic_util:to_atom(Function), emit(Fd, "oe_tc(~p) -> \n\t~p;\n",[FunctionAtom, {R, IN, OUT}]), GI = io_lib:format("{~p, oe_tc(~p)}",[Function, FunctionAtom]), gen_oe_tc2(G, N, Rest, Fd, [GI|Acc]); gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) -> {GetT, SetT} = mk_attr_func_types([], X), NewAcc = lists:foldl(fun(Id, FunAcc) -> {Get, Set} = mk_attr_func_names([], get_id(Id)), GetAttrAtom = ic_util:to_atom(Get), emit(Fd, "oe_tc(~p) -> \n\t~p;\n", [GetAttrAtom, GetT]), case X#attr.readonly of {readonly, _} -> GI = io_lib:format("{~p, oe_tc(~p)}", [Get, GetAttrAtom]), [GI|FunAcc]; _ -> SetAttrAtom = ic_util:to_atom(Set), emit(Fd, "oe_tc(~p) -> \n\t~p;\n", [SetAttrAtom, SetT]), GetGI = io_lib:format("{~p, oe_tc(~p)}", [Get, GetAttrAtom]), SetGI = io_lib:format("{~p, oe_tc(~p)}", [Set, SetAttrAtom]), [GetGI, SetGI|FunAcc] end end, Acc, ic_forms:get_idlist(X)), gen_oe_tc2(G, N, Rest, Fd, NewAcc); gen_oe_tc2(G,N,[_X|Rest], Fd, Acc) -> gen_oe_tc2(G,N,Rest, Fd, Acc). gen_oe_tc3(_,_,[],_, Acc) -> Acc; gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, op) -> Function = get_id2(X), FunctionAtom = ic_util:to_atom(get_id2(X)), GI = io_lib:format("{~p, ~p:oe_tc(~p)}",[Function, N, FunctionAtom]), emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", [FunctionAtom, N, FunctionAtom]), gen_oe_tc3(G, N, Rest, Fd, [GI|Acc]); gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) -> NewAcc = lists:foldl(fun(Id, FunAcc) -> {Get, Set} = mk_attr_func_names([], get_id(Id)), GetAttrAtom = ic_util:to_atom(Get), emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", [GetAttrAtom, N, GetAttrAtom]), case X#attr.readonly of {readonly, _} -> [io_lib:format("{~p, ~p:oe_tc(~p)}", [Get, N, GetAttrAtom])|FunAcc]; _ -> SetAttrAtom = ic_util:to_atom(Set), emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", [SetAttrAtom, N, SetAttrAtom]), [io_lib:format("{~p, ~p:oe_tc(~p)}", [Get, N, GetAttrAtom]), io_lib:format("{~p, ~p:oe_tc(~p)}", [Set, N, SetAttrAtom])|FunAcc] end end, Acc, ic_forms:get_idlist(X)), gen_oe_tc3(G, N, Rest, Fd, NewAcc); gen_oe_tc3(G,N,[_X|Rest], Fd, Acc) -> gen_oe_tc3(G,N,Rest, Fd, Acc). gen_calls(G, N, [X|Xs]) when is_record(X, op) -> case is_oneway(X) of false -> {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, false, get_opt(G, be)), gen_calls(G, N, Xs); true -> gen_calls(G, N, Xs) end; gen_calls(G, N, [X|Xs]) when is_record(X, attr) -> emit_attr(G, N, X, fun emit_skel_func/9), gen_calls(G, N, Xs); gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs); gen_calls(_G, _N, []) -> ok. gen_casts(G, N, [X|Xs]) when is_record(X, op) -> case is_oneway(X) of true -> {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, true, get_opt(G, be)), gen_casts(G, N, Xs); false -> gen_casts(G, N, Xs) end; gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs); gen_casts(_G, _N, []) -> ok. emit_attr(G, N, X, F) -> XX = #id_of{type=X}, BE = get_opt(G, be), {GetType, SetType} = mk_attr_func_types(N, X), lists:foreach(fun(Id) -> X2 = XX#id_of{id=Id}, {Get, Set} = mk_attr_func_names(N, get_id(Id)), F(G, N, X2, Get, [], GetType, [], is_oneway(X2), BE), case X#attr.readonly of {readonly, _} -> ok; _ -> F(G, N, X2, Set, [mk_name(G, "Value")], SetType, [], is_oneway(X2), BE) end end, ic_forms:get_idlist(X)). extract_info(G, _N, X) when is_record(X, op) -> Name = get_id2(X), InArgs = ic:filter_params([in,inout], X#op.params), OutArgs = ic:filter_params([out,inout], X#op.params), ArgNames = mk_erl_vars(G, InArgs), TypeList = {ic_forms:get_tk(X), map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) }, {Name, ArgNames, TypeList, OutArgs}. %% This function generates the standard functions of an object %% gen_server emit_serv_std(erl_corba, G, N, X) -> Fd = ic_genobj:stubfiled(G), Impl = ic_genobj:impl(G), TypeID = ictk:get_IR_ID(G, N, X), nl(Fd), nl(Fd), nl(Fd), ic_codegen:mcomment(Fd, ["Object server implementation."]), nl(Fd), nl(Fd), ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), nl(Fd), emit(Fd, "typeID() ->\n"), emit(Fd, " \"~s\".\n", [TypeID]), nl(Fd), nl(Fd), ic_codegen:mcomment(Fd, ["Object creation functions."]), nl(Fd), emit(Fd, "oe_create() ->\n"), emit(Fd, " corba:create(?MODULE, \"~s\").\n", [TypeID]), nl(Fd), emit(Fd, "oe_create_link() ->\n"), emit(Fd, " corba:create_link(?MODULE, \"~s\").\n", [TypeID]), nl(Fd), emit(Fd, "oe_create(Env) ->\n"), emit(Fd, " corba:create(?MODULE, \"~s\", Env).\n", [TypeID]), nl(Fd), emit(Fd, "oe_create_link(Env) ->\n"), emit(Fd, " corba:create_link(?MODULE, \"~s\", Env).\n", [TypeID]), nl(Fd), emit(Fd, "oe_create(Env, RegName) ->\n"), emit(Fd, " corba:create(?MODULE, \"~s\", Env, RegName).\n", [TypeID]), nl(Fd), emit(Fd, "oe_create_link(Env, RegName) ->\n"), emit(Fd, " corba:create_link(?MODULE, \"~s\", Env, RegName).\n", [TypeID]), nl(Fd), ic_codegen:mcomment(Fd, ["Init & terminate functions."]), nl(Fd), emit(Fd, "init(Env) ->\n"), ic_codegen:comment(Fd, "Call to implementation init"), emit(Fd, " corba:handle_init(~p, Env).\n", [to_atom(Impl)]), nl(Fd), emit(Fd, "terminate(Reason, State) ->\n"), emit(Fd, " corba:handle_terminate(~p, Reason, State).\n", [to_atom(Impl)]), nl(Fd), nl(Fd), Fd; emit_serv_std(erl_genserv, G, N, X) -> Fd = ic_genobj:stubfiled(G), Impl = ic_genobj:impl(G), TypeID = ictk:get_IR_ID(G, N, X), nl(Fd), nl(Fd), nl(Fd), ic_codegen:mcomment(Fd, ["Server implementation."]), nl(Fd), nl(Fd), ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), nl(Fd), emit(Fd, "typeID() ->\n"), emit(Fd, " \"~s\".\n", [TypeID]), nl(Fd), nl(Fd), ic_codegen:mcomment(Fd, ["Server creation functions."]), nl(Fd), emit(Fd, "oe_create() ->\n"), emit(Fd, " start([], []).\n", []), nl(Fd), emit(Fd, "oe_create_link() ->\n"), emit(Fd, " start_link([], []).\n", []), nl(Fd), emit(Fd, "oe_create(Env) ->\n"), emit(Fd, " start(Env, []).\n", []), nl(Fd), emit(Fd, "oe_create_link(Env) ->\n"), emit(Fd, " start_link(Env, []).\n", []), nl(Fd), emit(Fd, "oe_create(Env, RegName) ->\n"), emit(Fd, " start(RegName, Env, []).\n", []), nl(Fd), emit(Fd, "oe_create_link(Env, RegName) ->\n"), emit(Fd, " start_link(RegName, Env, []).\n", []), nl(Fd), ic_codegen:mcomment(Fd, ["Start functions."]), nl(Fd), emit(Fd, "start(Env, Opt) ->\n"), emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"), nl(Fd), emit(Fd, "start_link(Env, Opt) ->\n"), emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"), nl(Fd), emit(Fd, "start(RegName, Env, Opt) ->\n"), emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"), nl(Fd), emit(Fd, "start_link(RegName, Env, Opt) ->\n"), emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"), nl(Fd), ic_codegen:comment(Fd, "Standard gen_server termination"), emit(Fd, "stop(OE_THIS) ->\n"), emit(Fd, " gen_server:cast(OE_THIS,stop).\n"), nl(Fd), ic_codegen:comment(Fd, "Call to implementation init"), emit(Fd, "init(Env) ->\n"), emit(Fd, " ~p:~p(Env).\n", [to_atom(Impl), init]), nl(Fd), emit(Fd, "terminate(Reason, State) ->\n"), emit(Fd, " ~p:~p(Reason, State).\n", [to_atom(Impl), terminate]), nl(Fd), nl(Fd), Fd. gen_end_of_call(erl_corba, G) -> Fd = ic_genobj:stubfiled(G), nl(Fd), nl(Fd), ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), emit(Fd, "handle_call(stop, _, State) ->\n"), emit(Fd, " {stop, normal, ok, State}"), case get_opt(G, serv_last_call) of exception -> emit(Fd, ";\n"), nl(Fd), emit(Fd, "handle_call(_, _, State) ->\n"), emit(Fd, " {reply, catch corba:raise(#'BAD_OPERATION'{minor=1163001857, completion_status='COMPLETED_NO'}), State}.\n"); exit -> emit(Fd, ".\n"), nl(Fd), nl(Fd) end, ok; gen_end_of_call(erl_genserv, G) -> Fd = ic_genobj:stubfiled(G), nl(Fd), nl(Fd), ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), emit(Fd, "handle_call(stop, _, State) ->\n"), emit(Fd, " {stop, normal, ok, State}"), emit(Fd, ".\n"), nl(Fd), nl(Fd), ok. gen_end_of_cast(erl_corba, G) -> Fd = ic_genobj:stubfiled(G), nl(Fd), nl(Fd), ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), emit(Fd, "handle_cast(stop, State) ->\n"), emit(Fd, " {stop, normal, State}"), case get_opt(G, serv_last_call) of exception -> emit(Fd, ";\n"), nl(Fd), emit(Fd, "handle_cast(_, State) ->\n"), emit(Fd, " {noreply, State}.\n"); exit -> emit(Fd, ".\n"), nl(Fd), nl(Fd) end, ok; gen_end_of_cast(erl_genserv, G) -> Fd = ic_genobj:stubfiled(G), nl(Fd), nl(Fd), ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), emit(Fd, "handle_cast(stop, State) ->\n"), emit(Fd, " {stop, normal, State}"), emit(Fd, ".\n"), nl(Fd), nl(Fd), ok. emit_skel_footer(erl_corba, G, N, X) -> Fd = ic_genobj:stubfiled(G), nl(Fd), nl(Fd), ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), case use_impl_handle_info(G, N, X) of true -> emit(Fd, "handle_info(Info, State) ->\n"), emit(Fd, " corba:handle_info(~p, Info, State).\n\n", [list_to_atom(ic_genobj:impl(G))]); false -> emit(Fd, "handle_info(_, State) ->\n"), emit(Fd, " {noreply, State}.\n\n") end, nl(Fd), case get_opt(G, no_codechange) of false -> emit(Fd, "code_change(OldVsn, State, Extra) ->\n"), emit(Fd, " corba:handle_code_change(~p, OldVsn, State, Extra).\n\n", [list_to_atom(ic_genobj:impl(G))]); true -> emit(Fd, "code_change(_, State, _) ->\n"), emit(Fd, " {ok, State}.\n\n") end, ok; emit_skel_footer(erl_genserv, G, N, X) -> Fd = ic_genobj:stubfiled(G), nl(Fd), nl(Fd), ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), case use_impl_handle_info(G, N, X) of true -> emit(Fd, "handle_info(Info, State) ->\n"), emit(Fd, " ~p:handle_info(Info, State).\n\n", [list_to_atom(ic_genobj:impl(G))]); false -> emit(Fd, "handle_info(_, State) ->\n"), emit(Fd, " {noreply, State}.\n\n") end, nl(Fd), nl(Fd), case get_opt(G, no_codechange) of false -> emit(Fd, "code_change(OldVsn, State, Extra) ->\n"), emit(Fd, " ~p:code_change(OldVsn, State, Extra).\n\n", [list_to_atom(ic_genobj:impl(G))]); true -> emit(Fd, "code_change(_, State, _) ->\n"), emit(Fd, " {ok, State}.\n\n") end, ok. use_impl_handle_info(G, N, X) -> FullName = ic_util:to_colon([get_id2(X) | N]), case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of {_, force_false} -> false; {false, false} -> false; _ -> true end. use_timeout(G, N, _X) -> FullName = ic_util:to_colon(N), case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of {_, force_false} -> false; {false, false} -> false; _ -> true end. use_precond(G, N, X) -> FullName = ic_util:to_colon([get_id2(X) | N]), case get_opt(G, {precond, FullName}) of false -> InterfaceName = ic_util:to_colon(N), case get_opt(G, {precond, InterfaceName}) of false -> case get_opt(G, precond) of false -> false; V2 -> V2 end; V2 -> V2 end; V1 -> V1 end. use_postcond(G, N, X) -> FullName = ic_util:to_colon([get_id2(X) | N]), case get_opt(G, {postcond, FullName}) of false -> InterfaceName = ic_util:to_colon(N), case get_opt(G, {postcond, InterfaceName}) of false -> case get_opt(G, postcond) of false -> false; V3 -> V3 end; V2 -> V2 end; V1 -> V1 end. %%------------------------------------------------------------ %% %% Export stuff %% %% Gathering of all names that should be exported from a stub %% file. %% gen_head_special(G, N, X) when is_record(X, interface) -> Fd = ic_genobj:stubfiled(G), foreach(fun({Name, Body}) -> ic_codegen:comment(Fd, "Exports from ~p", [ic_util:to_colon(Name)]), ic_codegen:export(Fd, exp_top(G, N, Body, [], get_opt(G, be))), nl(Fd) end, X#interface.inherit_body), ic_codegen:comment(Fd, "Type identification function"), ic_codegen:export(Fd, [{typeID, 0}]), nl(Fd), ic_codegen:comment(Fd, "Used to start server"), ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1}, {oe_create_link, 1}, {oe_create, 2}, {oe_create_link, 2}]), nl(Fd), case get_opt(G, be) of erl_corba -> ic_codegen:comment(Fd, "TypeCode Functions and inheritance"), ic_codegen:export(Fd, [{oe_tc, 1}, {oe_is_a, 1}, {oe_get_interface, 0}]); _ -> ic_codegen:export(Fd, [{start, 2}, {start_link, 3}]) end, nl(Fd), ic_codegen:comment(Fd, "gen server export stuff"), emit(Fd, "-behaviour(gen_server).\n"), case get_opt(G, be) of erl_genserv -> %% stop/1 is only for erl_genserv backend ic_codegen:export(Fd, [{stop, 1}, {init, 1}, {terminate, 2}, {handle_call, 3}, {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]); _ -> ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {handle_call, 3}, {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]) end, case get_opt(G, be) of erl_corba -> nl(Fd), emit(Fd, "-include_lib(\"~s/include/~s\").\n", [?ORBNAME, ?CORBAHRL]); _ -> ok end, nl(Fd), nl(Fd), ic_codegen:mcomment(Fd, ["Object interface functions."]), nl(Fd), nl(Fd), nl(Fd), Fd; gen_head_special(_G, _N, _X) -> ok. %% Shall generate all export declarations gen_head(G, N, X) -> case ic_genobj:is_stubfile_open(G) of true -> F = ic_genobj:stubfiled(G), ic_codegen:comment(F, "Interface functions"), ic_codegen:export(F, exp_top(G, N, X, [], get_opt(G, be))), nl(F), gen_head_special(G, N, X); false -> ok end. exp_top(_G, _N, X, Acc, _) when element(1, X) == preproc -> Acc; exp_top(G, N, L, Acc, BE) when is_list(L) -> exp_list(G, N, L, Acc, BE); exp_top(G, N, M, Acc, BE) when is_record(M, module) -> exp_list(G, N, get_body(M), Acc, BE); exp_top(G, N, I, Acc, BE) when is_record(I, interface) -> exp_list(G, N, get_body(I), Acc, BE); exp_top(G, N, X, Acc, BE) -> exp3(G, N, X, Acc, BE). exp3(_G, _N, C, Acc, _BE) when is_record(C, const) -> [{get_id(C#const.id), 0} | Acc]; exp3(_G, _N, Op, Acc, erl_corba) when is_record(Op, op) -> FuncName = get_id(Op#op.id), Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1, [{FuncName, Arity}, {FuncName, Arity+1} | Acc]; exp3(G, N, Op, Acc, _BE) when is_record(Op, op) -> FuncName = get_id(Op#op.id), Arity = case use_timeout(G,N,Op) of true -> %% NO TimeOut on ONEWAYS here !!!! case is_oneway(Op) of true -> length(ic:filter_params([in, inout], Op#op.params)) + 1; false -> length(ic:filter_params([in, inout], Op#op.params)) + 2 end; false -> length(ic:filter_params([in, inout], Op#op.params)) + 1 end, [{FuncName, Arity} | Acc]; exp3(_G, _N, A, Acc, erl_corba) when is_record(A, attr) -> lists:foldr(fun(Id, Acc2) -> {Get, Set} = mk_attr_func_names([], get_id(Id)), case A#attr.readonly of {readonly, _} -> [{Get, 1}, {Get, 2} | Acc2]; _ -> [{Get, 1}, {Get, 2}, {Set, 2}, {Set, 3} | Acc2] end end, Acc, ic_forms:get_idlist(A)); exp3(_G, _N, A, Acc, _BE) when is_record(A, attr) -> lists:foldr(fun(Id, Acc2) -> {Get, Set} = mk_attr_func_names([], get_id(Id)), case A#attr.readonly of {readonly, _} -> [{Get, 1} | Acc2]; _ -> [{Get, 1}, {Set, 2} | Acc2] end end, Acc, ic_forms:get_idlist(A)); exp3(_G, _N, _X, Acc, _BE) -> Acc. exp_list(G, N, L, OrigAcc, BE) -> lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc, BE) end, OrigAcc, L). %%------------------------------------------------------------ %% %% Emit stuff %% %% Low level generation primitives %% emit_stub_func(G, N, X, Name, ArgNames, _TypeList, OutArgs, Oneway, Backend) -> case ic_genobj:is_stubfile_open(G) of false -> ok; true -> Fd = ic_genobj:stubfiled(G), StubName = list_to_atom(Name), UsingTimeout = use_timeout(G, N, X), Timeout = case UsingTimeout of true -> mk_name(G, "Timeout"); false -> "infinity" end, Options = mk_name(G, "Options"), This = mk_name(G, "THIS"), CallOrCast = case is_oneway(X) of true -> ?CAST; _ -> ?CALL end, emit_op_comment(G, Fd, X, StubName, ArgNames, OutArgs), case Backend of erl_corba -> emit(Fd, "~p(~s) ->\n", [StubName, mk_list([This | ArgNames])]), emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE).\n\n", [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames)]), emit(Fd, "~p(~s) ->\n", [StubName, mk_list([This, Options| ArgNames])]), emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE, ~s).\n\n", [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames), Options]); _ -> FunName = case ic_options:get_opt(G, scoped_op_calls) of true -> list_to_atom(ic_util:to_undersc([Name | N])); false -> StubName end, %% NO TimeOut on ONEWAYS here !!!! case Oneway of true -> emit(Fd, "~p(~s) ->\n", [StubName, mk_list([This | ArgNames])]); false -> case UsingTimeout of true -> emit(Fd, "~p(~s) ->\n", [StubName, mk_list([This, Timeout| ArgNames])]); false -> emit(Fd, "~p(~s) ->\n", [StubName, mk_list([This | ArgNames])]) end end, %% NO TimeOut on ONEWAYS here !!!! if length(ArgNames) == 0 -> case is_oneway(X) of true -> emit(Fd, " ~s:~s(~s, ~p).\n\n", [?GENSERVMOD, CallOrCast, This, FunName]); false -> emit(Fd, " ~s:~s(~s, ~p, ~s).\n\n", [?GENSERVMOD, CallOrCast, This, FunName, Timeout]) end; true -> case is_oneway(X) of true -> emit(Fd, " ~s:~s(~s, {~p, ~s}).\n\n", [?GENSERVMOD, CallOrCast, This, FunName, mk_list(ArgNames)]); false -> emit(Fd, " ~s:~s(~s, {~p, ~s}, ~s).\n\n", [?GENSERVMOD, CallOrCast, This, FunName, mk_list(ArgNames), Timeout]) end end end end. emit_skel_func(G, N, X, OpName, ArgNames, TypeList, OutArgs, Oneway, Backend) -> case ic_genobj:is_stubfile_open(G) of false -> ok; true -> emit_skel_func_helper(G, N, X, OpName, ArgNames, TypeList, OutArgs, Oneway, Backend) end. emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway, erl_corba) -> Fd = ic_genobj:stubfiled(G), Name = list_to_atom(OpName), ImplF = Name, ImplM = list_to_atom(ic_genobj:impl(G)), ThisStr = mk_name(G, "THIS"), FromStr = mk_name(G, "From"), State = mk_name(G, "State"), Context = mk_name(G, "Context"), {UseFrom, From} = case Oneway of false -> case use_from(G, N, OpName) of true -> {FromStr, FromStr}; false -> {"false", "_"} end; true -> {"false", "_"} end, {UseThis, This} = case use_this(G, N, OpName) of true -> {ThisStr, ThisStr}; false -> {"false", "_"} end, %% Create argument list string CallArgs = mk_list(ArgNames), emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs), %% Check if pre and post conditions are specified for this operation Precond = use_precond(G, N, X), Postcond = use_postcond(G, N, X), case Oneway of true -> emit(Fd, "handle_cast({~s, ~s, ~p, [~s]}, ~s) ->\n", [This, Context, Name, CallArgs, State]), case {Precond, Postcond} of {false, false} -> emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s);\n\n", [ImplM, ImplF, CallArgs, State, Context, UseThis]); _ -> emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n", [ImplM, ImplF, CallArgs, State, Context, UseThis, Precond, Precond]) end; false -> emit(Fd, "handle_call({~s, ~s, ~p, [~s]}, ~s, ~s) ->\n", [This, Context, Name, CallArgs, From, State]), case {Precond, Postcond} of {false, false} -> emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s);\n\n", [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom]); _-> emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n", [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom, Precond, Postcond]) end end; emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway, _Backend) -> Fd = ic_genobj:stubfiled(G), Name = list_to_atom(OpName), ImplF = Name, ImplM = list_to_atom(ic_genobj:impl(G)), FromStr = mk_name(G, "From"), State = mk_name(G, "State"), %% Create argument list CallArgs1 = [State | ArgNames], {CallArgs2, From} = case is_oneway(X) of false -> case use_from(G, N, OpName) of true -> {[FromStr | CallArgs1], FromStr}; false -> {CallArgs1, "_"} end; true -> {CallArgs1, "_"} end, %% Create argument list string CallArgs = mk_list(CallArgs2), emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs), FunName = case ic_options:get_opt(G, scoped_op_calls) of true -> list_to_atom(ic_util:to_undersc([OpName | N])); false -> list_to_atom(OpName) end, case Oneway of true -> if length(ArgNames) == 0 -> emit(Fd, "handle_cast(~p, ~s) ->\n", [FunName, State]); true -> emit(Fd, "handle_cast({~p, ~s}, ~s) ->\n", [FunName, mk_list(ArgNames), State]) end, emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]); false -> if length(ArgNames) == 0 -> emit(Fd, "handle_call(~p, ~s, ~s) ->\n", [FunName, From, State]); true -> emit(Fd, "handle_call({~p, ~s}, ~s, ~s) ->\n", [FunName, mk_list(ArgNames), From, State]) end, emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]) end. use_this(G, N, OpName) -> FullOp = ic_util:to_colon([OpName|N]), FullIntf = ic_util:to_colon(N), case {get_opt(G, {this, FullIntf}), get_opt(G, {this, FullOp}), get_opt(G, {this, true})} of {_, force_false, _} -> false; {force_false, false, _} -> false; {false, false, false} -> false; _ -> true end. use_from(G, N, OpName) -> FullOp = ic_util:to_colon([OpName|N]), FullIntf = ic_util:to_colon(N), case {get_opt(G, {from, FullIntf}), get_opt(G, {from, FullOp}), get_opt(G, {from, true})} of {_, force_false, _} -> false; {force_false, false, _} -> false; {false, false, false} -> false; _ -> true 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])]). emit_op_comment(G, F, X, Name, InP, OutP) -> ic_codegen:mcomment_light(F, [io_lib:format("~s: ~p", [get_title(X), Name]), "", get_returns(G, X, InP, OutP) | get_raises(X)]). get_title(X) when is_record(X, attr) -> "Attribute Operation"; get_title(_X) -> "Operation". get_raises(X) when is_record(X, op) -> if X#op.raises == [] -> []; true -> [" Raises: " ++ mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, X#op.raises))] end; get_raises(_X) -> []. get_returns(_G, _X, _InP, []) -> " Returns: RetVal"; get_returns(G, _X, _InP, OutP) -> " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]). %%------------------------------------------------------------ %% %% 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}. %% {scoped_name(Scope, "_get_"++Name), scoped_name(Scope, "_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 is_list(L) -> lists:flatten(map(fun(X) -> unfold2(X) end, L)); unfold(X) -> unfold2(X). unfold2(A) when is_record(A, attr) -> map(fun(Id) -> A#attr{id=Id} end, A#attr.id); unfold2(M) when is_record(M, member) -> map(fun(Id) -> M#member{id=Id} end, M#member.id); unfold2(M) when is_record(M, case_dcl) -> map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label); unfold2(T) when is_record(T, typedef) -> map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id). %% 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\n", []), emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]).