ic_noc.erl

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

%% ``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_noc).


-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").




%%------------------------------------------------------------
%%
%% 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) -> 
    G2 = ic_file:filename_push(G, [], mk_oe_name(G, 
					       ic_file:remove_ext(to_list(File))),
			     erlang),
    gen_head(G2, [], Form),
    exportDependency(G2),
    %% Loop through form and adds inheritence data
    ic_pragma:preproc(G2, [], Form),
    gen(G2, [], Form),
    genDependency(G2),
    ic_file:filename_pop(G2, erlang),
    ok.


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),

    case getNocType(G,X,N) of
	transparent ->
	    emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs);
	multiple ->
	    mark_not_transparent(G,N),
	    emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs);
	_XTuple ->
	    mark_not_transparent(G,N),
	    emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs)
    end,

    gen(G, N, Xs);
	

gen(G, N, [X|Xs]) when record(X, attr) ->
    emit_attr(G, N, X, fun emit_stub_func/7),
    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 ->
	    emit_serv_std(G, N, X),
	    N2 = [get_id2(X) | N], 
	    gen_calls(G, N2, get_body(X)),
	    lists:foreach(fun({_Name, Body}) ->
				  gen_calls(G, N2, Body) end,
			  X#interface.inherit_body),
	    get_if_gen(G, N2, X),
	    gen_end_of_call(G, N, X),		% Note N instead of N2

	    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(G, N, X),		% Note N instead of N2
	    emit_skel_footer(G, N, X);		% Note N instead of N2
	false ->
	    ok
    end.

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),
	    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/7),
    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),
	    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},
    {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, []),
			  case X#attr.readonly of
			      {readonly, _} -> ok;
			      _ -> 
				  F(G, N, X2, Set, [mk_name(G, "Value")], 
				    SetType, [])
			  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}.




emit_serv_std(G, N, X) ->
    Fd = ic_genobj:stubfiled(G),
    case transparent(G) of
	true ->
	    true;
	_XTupleORMultiple ->
	    Impl	= getImplMod(G,X,[get_id2(X)|N]),
	    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, "Call to implementation init"),
	    emit(Fd, "init(Env) ->\n"),
	    emit(Fd, "    ~p:~p(Env).\n", [Impl, init]),
	    nl(Fd),
	    emit(Fd, "terminate(Reason, State) ->\n"),
	    emit(Fd, "    ~p:~p(Reason, State).\n", 
		 [Impl, terminate]),
	    nl(Fd), nl(Fd)
    end,
    Fd.




gen_end_of_call(G, _N, _X) ->
    case transparent(G) of
	true ->
	    true;
	_XTuple ->
	    Fd = ic_genobj:stubfiled(G),
	    nl(Fd), nl(Fd),
	    ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]),
	    emit(Fd, "handle_call(stop, From, 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(Req, From, State) ->\n"),
		    emit(Fd, "    {reply, ~p, State}.\n",[getCallErr()]);
		exit ->
		    emit(Fd, ".\n"),
		    nl(Fd),
		    nl(Fd)
	    end
    end,
    ok.


gen_end_of_cast(G, _N, _X) ->
    case transparent(G) of
	true ->
	    true;
	_XTuple ->
	    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(Req, State) ->\n"),
		    emit(Fd, "    {reply, ~p, State}.\n",[getCastErr()]);
		exit ->
		    emit(Fd, ".\n"),
		    nl(Fd), nl(Fd)
	    end
    end,
    ok.


emit_skel_footer(G, N, X) ->
    case transparent(G) of
	true ->
	    true;
	_XTuple ->
	    Fd = ic_genobj:stubfiled(G),
	    nl(Fd), nl(Fd),
	    ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]),
	    emit(Fd, "handle_info(X, State) ->\n"),
	    case use_impl_handle_info(G, N, X) of
		true ->
		    emit(Fd, "    ~p:handle_info(X, State).\n\n", 
			 [list_to_atom(ic_genobj:impl(G))]);
		false ->
		    emit(Fd, "    {reply, ~p, State}.\n\n",[getInfoErr()])
	    end
    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.


get_if_name(G) -> mk_oe_name(G, "get_interface").


%% Generates the get_interface function (for Lars)
get_if_gen(G, N, X) ->
    case transparent(G) of
	true ->
	    ok;
	_XTuple ->
	    case ic_genobj:is_stubfile_open(G) of
		true ->
		    IFC_TKS = tk_interface_data(G,N,X),
		    Fd = ic_genobj:stubfiled(G),
		    Name = to_atom(get_if_name(G)),

		    ic_codegen:mcomment_light(Fd, 
					 [io_lib:format("Standard Operation: ~p",
							[Name])]),

		    emit(Fd, "handle_call({~s, ~p, []}, From, State) ->~n",
			 [mk_name(G, "Ref"), Name]),

		    emit(Fd, "    {reply, ~p, State};~n", [IFC_TKS]),
		    nl(Fd),
		    ok;

		false -> ok
	    end
    end.


get_if(G,N,[X|Rest]) 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)),
    case print_tk(G,N,X) of
	true ->
	    [{get_id2(X), {R, IN, OUT}} | get_if(G,N,Rest)];
	false ->
	    get_if(G,N,Rest)
    end;

get_if(G,N,[X|Rest]) when record(X, attr) -> %% Attributes not handled so far <<<<<<<<<<<<<<<<<<<<<<<<
    {GetT, SetT} = mk_attr_func_types([], X),
    AList = lists:map(fun(Id) -> 
			      {Get, Set} = mk_attr_func_names([], get_id(Id)),
			      case X#attr.readonly of
				  {readonly, _} -> 
				      {Get, GetT};
				  _ -> 
				      [{Set, SetT}, {Get, GetT}]
			      end end, ic_forms:get_idlist(X)),
    lists:flatten(AList) ++ get_if(G,N,Rest);

get_if(G,N,[_X|Rest]) -> get_if(G,N,Rest);
get_if(_,_,[]) -> [].




%%------------------------------------------------------------
%%
%% 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),
    NocType = getNocType(G,X,N),

    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, NocType, [])),
		    nl(Fd)
	    end, X#interface.inherit_body),

    case transparent(G) of
	true ->
	    nl(Fd), nl(Fd);
	_XTuple ->
	    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, [{start, 2},{start_link, 3}]),
	    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),
	    ic_codegen:comment(Fd, "gen server export stuff"),
	    emit(Fd, "-behaviour(gen_server).\n"),
	    ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {handle_call, 3}, 
			      {handle_cast, 2}, {handle_info, 2}]),
	    nl(Fd), nl(Fd),
	    ic_codegen:mcomment(Fd, ["Object interface functions."]),
	    nl(Fd), nl(Fd), nl(Fd)
    end,
    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, getNocType(G,X,N), [])), 
	    nl(F),
	    gen_head_special(G, N, X);
	false -> ok
    end.

exp_top(_G, _N, X, _NT, Acc)  when element(1, X) == preproc -> 
    Acc;
exp_top(G, N, L, NT, Acc)  when list(L) ->
    exp_list(G, N, L, NT, Acc);
exp_top(G, N, M, NT, Acc)  when record(M, module) ->
    exp_list(G, N, get_body(M), NT, Acc);
exp_top(G, N, I, NT, Acc)  when record(I, interface) ->
    exp_list(G, N, get_body(I), NT, Acc);
exp_top(G, N, X, NT, Acc) ->
    exp3(G, N, X, NT, Acc).

exp3(_G, _N, C, _NT, Acc)  when record(C, const) -> 
    [{get_id(C#const.id), 0} | Acc];

exp3(G, N, Op, NocType, Acc)  when record(Op, op) ->
    FuncName = get_id(Op#op.id),
    
    TA = case use_timeout(G,N,Op) of
	     true ->
		 1;
	     false ->
		 0
	 end,

    case NocType of
	transparent ->
	    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
	    [{FuncName, Arity} | Acc];
	multiple ->
	    case getModType(G, Op, N) of
		dt ->
		    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
		    [{FuncName, Arity} | Acc];
		do ->
		    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
		    [{FuncName, Arity} | Acc];
		spt ->
		    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
		    [{FuncName, Arity} | Acc];
		spo ->
		    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
		    [{FuncName, Arity} | Acc]
	    end;
	_ ->
	    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
	    [{FuncName, Arity} | Acc]
    end;
exp3(_G, _N, A, _NT, Acc)  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} | Acc2];