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

    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 is_record(X, attr) ->
    emit_attr(G, N, X, fun emit_stub_func/7),
    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 ->
	    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 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),
	    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/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 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),
	    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 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}.




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 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)),
    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 is_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 is_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 is_list(L) ->
    exp_list(G, N, L, NT, Acc);
exp_top(G, N, M, NT, Acc)  when is_record(M, module) ->
    exp_list(G, N, get_body(M), NT, Acc);
exp_top(G, N, I, NT, Acc)  when is_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 is_record(C, const) -> 
    [{get_id(C#const.id), 0} | Acc];

exp3(G, N, Op, NocType, Acc)  when is_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 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, _NT, Acc) -> Acc.

exp_list(G, N, L, NT, OrigAcc) -> 
    lists:foldr(fun(X, Acc) -> exp3(G, N, X, NT, Acc) end, OrigAcc, L).




%%------------------------------------------------------------
%%
%% Emit stuff
%%
%%	Low level generation primitives
%%

emit_stub_func(G, N, X, Name, ArgNames, TypeList, _OutArgs) ->
    case ic_genobj:is_stubfile_open(G) of
	false -> ok;
	true ->
	    Fd = ic_genobj:stubfiled(G),
	    StubName = list_to_atom(Name),
	    This = mk_name(G, "Ref"),
	    XTuple = getNocType(G,X,N),
	    CallOrCast = 
		case is_oneway(X) of 
		    true -> ?CAST; 
		    _ -> ?CALL
		end,

	    %% Type expand operation on comments
	    ic_code:type_expand_op(G,N,X,Fd),

	    case use_timeout(G,N,X) of
		true ->
		    Timeout = mk_name(G,"Timeout"),
		    emit(Fd, "~p(~s) ->\n", 
			 [StubName, mk_list([This, Timeout| ArgNames])]),
		    emit(Fd, "    ~p:~s(~s, ~s, ?MODULE, ~p, ~p, [~s], ~p).\n\n", 
			 [getImplMod(G,X,N), 
			  CallOrCast, 
			  This, 
			  Timeout, 
			  XTuple, 
			  StubName, 
			  mk_list(ArgNames), 
			  tk_operation_data(G, N, X, TypeList)]);
		false ->
		    emit(Fd, "~p(~s) ->\n", 
			 [StubName, mk_list([This | ArgNames])]),
		    
		    emit(Fd, "    ~p:~s(~s, ~p, ?MODULE, ~p, [~s], ~p).\n\n", 
			 [getImplMod(G,X,N), 
			  CallOrCast, 
			  This, 
			  XTuple, 
			  StubName, 
			  mk_list(ArgNames), 
			  tk_operation_data(G, N, X, TypeList)])
	    end
    end.


emit_transparent_func(G, N, X, Name, ArgNames, _TypeList, _OutArgs) ->
    case ic_genobj:is_stubfile_open(G) of
	false -> ok;
	true ->
	    Fd = ic_genobj:stubfiled(G),
	    OpName = list_to_atom(Name),
	    
	    ArgList = case use_timeout(G,N,X) of
			  true ->
			      mk_list([mk_name(G,"Ref"),mk_name(G,"Timeout")|ArgNames]);
			  false ->
			       mk_list([mk_name(G,"Ref")|ArgNames])
		      end,

	    %% Type expand operation on comments
	    ic_code:type_expand_op(G,N,X,Fd),

	    emit(Fd, "~p(~s) ->\n", [OpName,ArgList]),
	    emit(Fd, "    ~p:~s(~s).\n\n", [getImplMod(G,X,N), OpName, ArgList])
    end.






emit_skel_func(G, N, X, OpName, ArgNames, _TypeList, _OutArgs) ->
    case getNocType(G,X,N) of
	transparent ->
	    true;
	multiple ->
	    true;
	XTuple ->
	    case ic_genobj:is_stubfile_open(G) of
		false -> ok;
		true ->
		    Fd = ic_genobj:stubfiled(G),
		    Name	= list_to_atom(OpName),
		    This	= mk_name(G, "Ref"),
		    From	= mk_name(G, "From"),
		    State	= mk_name(G, "State"),
		    
		    %% Type expand handle operation on comments
		    ic_code:type_expand_handle_op(G,N,X,Fd),

		    case is_oneway(X) of
			true ->
			    emit(Fd, "handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s) ->\n",
				 [This, XTuple, Name, mk_list(ArgNames), State]),
			    emit(Fd, "    ~p:handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s);\n\n", 
				 [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), State]);
			false ->
			    emit(Fd, "handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s) ->\n",
				 [This, XTuple, Name, mk_list(ArgNames), From, State]),
			    emit(Fd, "    ~p:handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s);\n\n", 
				 [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), From, State])
		    end
	    end
    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])]).

%%------------------------------------------------------------
%%
%% 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}.

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






%% Export code produce for dependency function
exportDependency(G) ->
    Fd = ic_genobj:stubfiled(G),
    ic_codegen:export(Fd, [{oe_dependency, 0}]),
    nl(Fd).

%% 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", []),
    emit(Fd, "    ~p.\n\n", [ic_pragma:get_dependencies(G)]).   





%%%%%%


getImplMod(G,X,Scope) -> %% to_atom(ic_genobj:impl(G)) | ChoicedModuleName

    %% Get actual pragma appliance scope
    SpecScope = getActualScope(G,X,Scope),

    %% The "broker" option is passed 
    %% only by pragmas, seek for module.
    case ic_pragma:getBrokerData(G,X,SpecScope) of
	{Module,_Type} ->
	    Module;
	_List ->
	    element(1,ic_pragma:defaultBrokerData(G))
    end.


getNocType(G,X,Scope) when is_record(X, interface) -> %% default | specified 
    OpList = getAllOperationScopes(G,Scope),
    getNocType2(G,X,OpList);
getNocType(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN}
    getNocType3(G,X,Scope).

getNocType2(G,X,List) ->
    getNocType2(G,X,List,[]).

getNocType2(_,_,[],Found) ->
    selectTypeFromList(Found);
getNocType2(G,X,[OpScope|OpScopes],Found) ->
    getNocType2(G,X,OpScopes,[getNocType3(G,X,OpScope)|Found]).

getNocType3(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN}

    %% Get actual pragma appliance scope
    SpecScope = getActualScope(G,X,Scope),

    %% The "broker" option is passed 
    %% only by pragmas, seek for type.
    case ic_pragma:getBrokerData(G,X,SpecScope) of
	{_Module,Type} ->
	    Type;
	List ->
	    selectTypeFromList(List) %%transparent/multiple
    end.


getModType(G,X,Scope) -> %% default | specified 

    %% Get actual pragma appliance scope
    SpecScope = getActualScope(G,X,Scope),

    %% The "broker" option is passed 
    %% only by pragmas, seek for brokerdata.
    case ic_pragma:getBrokerData(G,X,SpecScope) of
	{Module,Type} ->
	    case Module == ic_genobj:impl(G) of
		true ->
		    case Type of 
			transparent ->
			    dt; %% default + transparent
			_ ->
			    do  %% default + opaque
		    end;
		false ->
		    case Type of 
			transparent ->
			    spt; %% specified + transparent
			_ ->
			    spo  %% specified + opaque
		    end
	    end;
	_List ->
	    dt
    end.



%%%%
%%
%% Returns a list of ALL operation full 
%% scoped names local and inherited
%% from other interfaces
%%

getAllOperationScopes(G,Scope) ->
    getOperationScopes(G,Scope) ++ 
	getInhOperationScopes(G,Scope).
	

getOperationScopes(G,Scope) ->
    getOpScopes(G,
		Scope,
		ets:match(ic_genobj:pragmatab(G),{op,'$0',Scope,'_','_'}),
		[]).

getOpScopes(_,_,[],OpScopes) ->
    OpScopes;
getOpScopes(G,Scope,[[Name]|Names],Found) ->
    getOpScopes(G,Scope,Names,[[Name|Scope]|Found]).


getInhOperationScopes(G,Scope) ->
    getInhOpScopes1(G,
		   Scope,
		   ets:match(ic_genobj:pragmatab(G),{inherits,Scope,'$1'}),
		   []).

getInhOpScopes1(G,_Scope,[],OpScopes) ->
    getInhOpScopes2(G,OpScopes);
getInhOpScopes1(G,Scope,[[SC]|SCs],Found) ->
    getInhOpScopes1(G,Scope,SCs,[SC|Found]).


getInhOpScopes2(G,Scopes) ->
    getInhOpScopes2(G,Scopes,[]).

getInhOpScopes2(_G,[],Found) ->
    Found;
getInhOpScopes2(G,[SC|SCs],Found) ->
   getOperationScopes(G,SC) ++ getInhOpScopes2(G,SCs,Found).

%%
%%
%%%%



%%%%
%%
%%
%% Seek the actual operation scope :
%%
%%   * if the operation is inherited, get the real scope for it
%%
%%   * if the operation has a specific pragma, apply the real
%%     scope, otherwise return the including scope 
%%
getActualScope(G, X, Scope) when is_record(X, op) ->
    OpScope = getRealOpScope(G,X,Scope),
    case ets:match(ic_genobj:pragmatab(G),{codeopt_specific,OpScope}) of
	[[]] ->
	    OpScope;
	_ ->
	    Scope
    end;
getActualScope(_G, _X, N) ->
    N.

%%
%%  Just seek and return the scope for the operation
%%  where it were originaly defined
%%
getRealOpScope(G,X,N) when is_record(X, op) ->
    Ptab = ic_genobj:pragmatab(G),
    Id = get_id2(X),
    
    case ets:match(Ptab,{op,Id,N,'_','_'}) of
	[[]] ->
	    [Id|N];
	_ ->
	    getRealOpScope(G, Ptab, X, N, Id,  ets:match(Ptab,{inherits,N,'$1'}))
    end;
getRealOpScope(_G,_X,N) ->
    N.

getRealOpScope(_G, _S, _X, N, Id, []) ->
    [Id|N];
getRealOpScope(G, S, X, N, Id, [[OS]|OSs]) -> 
    case ets:match(S,{op,Id,OS,'_','_'}) of
	[[]] ->
	    [Id|OS];
	_ ->
	    getRealOpScope(G, S, X, N, Id, OSs)
    end.
    
selectTypeFromList([]) ->
    transparent;
selectTypeFromList([{_,transparent}|Rest]) ->
    selectTypeFromList(Rest);
selectTypeFromList([transparent|Rest]) ->
    selectTypeFromList(Rest);
selectTypeFromList([_|_Rest]) ->
    multiple.



getCallErr() ->    
    {'ERROR' ,"Bad Operation -- handle call"}.

getCastErr() ->
    {'ERROR' ,"Bad Operation -- handle cast"}.

getInfoErr() ->
    {'ERROR' ,"Bad Operation -- handle info"}.






%%
%% Type code access utilities
%%

tk_operation_data(G, N, X, TL) ->
    case print_tk(G,N,X) of
	true ->
	    TL;
	false ->
	    no_tk
    end.

tk_interface_data(G, N, X) ->
    InfoList = 
	foldr(fun({_Name, Body}, Acc) ->
		      get_if(G,N,Body)++Acc end,
	      get_if(G,N,get_body(X)),
	      X#interface.inherit_body),
    case InfoList of
	[] ->
	    no_tk;  %%%%%%%% Should be changed to [] <<<<<<<<<<<<<<<<<<<<<<<<<<< Warning !
	_ ->
	    InfoList
    end.


print_tk(G, N, X) when is_record(X, op)-> %% operation
    case getNocType(G,X,N) of
	transparent ->
	    false;
	multiple ->
	    false;
	_XTuple -> %%check if there are any USETK pragmas
	    operation_usetk(G,N,X)
    end; 
print_tk(_G, _N, _X) -> %% error
    false.


operation_usetk(G,N,X) ->
    PTab = ic_genobj:pragmatab(G),
    OTab = ic_genobj:optiontab(G),
    OpName = get_id2(X),
%    SID = ic_util:to_colon(N),
    Res = case use_tk(OTab,[N]) of
	      {ok,N} ->
		  true;
	      false ->
		  %% Look if there is an operation with that name
                  %% which can be found in an included file.
		  case ets:match(PTab,{file_data_included,'_','_',op,'$3',OpName,'_','_','_'}) of
		      [] ->
			  false;
		      ScopeList ->
			  case use_tk(OTab,ScopeList) of
			      %% There is an operation with that name, 
			      %% look if it is inherited by interface "N"
			      {ok,FoundScope} ->
				  ic_pragma:is_inherited_by(FoundScope,N,PTab);
			      false ->
				  false
			  end
		  end
	  end,
    Res. 


use_tk(_,[]) ->
    false;
use_tk(OTab,[[Scope]|Scopes]) ->
    SID = ic_util:to_colon(Scope),
    case ets:match(OTab,{{option,{use_tk,SID}},true}) of
	[] ->
	    case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of
		[] ->
		    use_tk(OTab,Scopes);
		_ ->
		    {ok,Scope}
	    end;
	_ ->
	    {ok,Scope}
    end;
use_tk(OTab,[Scope|Scopes]) ->
    SID = ic_util:to_colon(Scope),
    case ets:match(OTab,{{option,{use_tk,SID}},true}) of
	[] ->
	    case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of
		[] ->
		    use_tk(OTab,Scopes);
		_ ->
		    {ok,Scope}
	    end;
	_ ->
	    {ok,Scope}
    end.





mark_not_transparent(G,N) ->

    %% Mark that there are multiple 
    %% functions in interface 
    S = ic_genobj:pragmatab(G),
    ets:insert(S,{no_transparent,N}).


transparent(G) ->
    
    S = ic_genobj:pragmatab(G),
    case ets:match_object(S,{no_transparent,'$0'}) of
	[] ->
	    true;
	_ ->
	    false
    end.