ic_erlbe.erl

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

%% 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 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 list(L) ->
    exp_list(G, N, L, Acc, BE);
exp_top(G, N, M, Acc, BE)  when record(M, module) ->
    exp_list(G, N, get_body(M), Acc, BE);
exp_top(G, N, I, Acc, BE)  when 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 record(C, const) ->
    [{get_id(C#const.id), 0} | Acc];
exp3(_G, _N, Op, Acc, erl_corba)  when 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 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 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 record(A, attr) ->
    lists:foldr(fun(Id, Acc2) ->