ic_erlbe.erl

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

%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
-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 record(X, preproc) ->
    NewG = ic:handle_preproc(G, N, X#preproc.cat, X),
    gen(NewG, N, Xs);

gen(G, N, [X|Xs]) when 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 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 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 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 record(X, attr) ->
    emit_attr(G, N, X, fun emit_stub_func/9),
    gen(G, N, Xs);

gen(G, N, [X|Xs]) when 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 record(X, typedef) -> true;
may_contain_structs(X) when record(X, struct) -> true;
may_contain_structs(X) when 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 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 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 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 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(~s);\n",
	 [FunctionAtom, N, Function]),
    gen_oe_tc3(G, N, Rest, Fd, [GI|Acc]);

gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when 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 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 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 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 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}.