aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ic/src/ic_erlbe.erl
diff options
context:
space:
mode:
authorLars Thorsen <[email protected]>2018-04-25 15:09:14 +0200
committerLars Thorsen <[email protected]>2018-04-27 12:05:30 +0200
commit6bcdad20c24457393c0d9eeb385d0ff5aa872cd0 (patch)
tree63162ddfa38d92eaff2193b73277aba18160308c /lib/ic/src/ic_erlbe.erl
parent87b06e4ab91729f7415578c8ac0aacec28720ad9 (diff)
downloadotp-6bcdad20c24457393c0d9eeb385d0ff5aa872cd0.tar.gz
otp-6bcdad20c24457393c0d9eeb385d0ff5aa872cd0.tar.bz2
otp-6bcdad20c24457393c0d9eeb385d0ff5aa872cd0.zip
Move the corba applcations to separate repository
All corba applications are moved to a separate repository. E.g. orber, ic, cosEvent, cosEventDomain, cosNotifications cosTime, cosTransactions, cosProperty and cosFileTransfer.
Diffstat (limited to 'lib/ic/src/ic_erlbe.erl')
-rw-r--r--lib/ic/src/ic_erlbe.erl1142
1 files changed, 0 insertions, 1142 deletions
diff --git a/lib/ic/src/ic_erlbe.erl b/lib/ic/src/ic_erlbe.erl
deleted file mode 100644
index d315a17e7c..0000000000
--- a/lib/ic/src/ic_erlbe.erl
+++ /dev/null
@@ -1,1142 +0,0 @@
-%%
-%% %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)]).