aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ic/src/ic_erlbe.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ic/src/ic_erlbe.erl')
-rw-r--r--lib/ic/src/ic_erlbe.erl1141
1 files changed, 1141 insertions, 0 deletions
diff --git a/lib/ic/src/ic_erlbe.erl b/lib/ic/src/ic_erlbe.erl
new file mode 100644
index 0000000000..75c87929db
--- /dev/null
+++ b/lib/ic/src/ic_erlbe.erl
@@ -0,0 +1,1141 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-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(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)]).