1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20%%
21-module(ic_noc).
22
23
24-export([do_gen/3]).
25%%------------------------------------------------------------
26%%
27%% Internal stuff
28%%
29%%------------------------------------------------------------
30
31-export([unfold/1, mk_attr_func_names/2]).
32
33
34-import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]).
35-import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]).
36-import(ic_codegen, [emit/2, emit/3, nl/1]).
37-import(ic_options, [get_opt/2]).
38
39
40-import(lists, [foreach/2, foldr/3, map/2]).
41
42
43-include("icforms.hrl").
44-include("ic.hrl").
45
46
47
48
49%%------------------------------------------------------------
50%%
51%% Generate the client side Erlang stubs.
52%%
53%% Each module is generated to a separate file.
54%%
55%% Export declarations for all interface functions must be
56%% generated. Each function then needs to generate a function head and
57%% a body. IDL parameters must be converted into Erlang parameters
58%% (variables, capitalised) and a type signature list must be
59%% generated (for later encode/decode).
60%%
61%%------------------------------------------------------------
62
63
64do_gen(G, File, Form) ->
65    G2 = ic_file:filename_push(G, [], mk_oe_name(G,
66					       ic_file:remove_ext(to_list(File))),
67			     erlang),
68    gen_head(G2, [], Form),
69    exportDependency(G2),
70    %% Loop through form and adds inheritence data
71    ic_pragma:preproc(G2, [], Form),
72    gen(G2, [], Form),
73    genDependency(G2),
74    ic_file:filename_pop(G2, erlang),
75    ok.
76
77
78gen(G, N, [X|Xs]) when is_record(X, preproc) ->
79    NewG = ic:handle_preproc(G, N, X#preproc.cat, X),
80    gen(NewG, N, Xs);
81
82gen(G, N, [X|Xs]) when is_record(X, module) ->
83    CD = ic_code:codeDirective(G,X),
84    G2 = ic_file:filename_push(G, N, X, CD),
85    N2 = [get_id2(X) | N],
86    gen_head(G2, N2, X),
87    gen(G2, N2, get_body(X)),
88    G3 = ic_file:filename_pop(G2, CD),
89    gen(G3, N, Xs);
90
91gen(G, N, [X|Xs]) when is_record(X, interface) ->
92    G2 = ic_file:filename_push(G, N, X, erlang),
93    N2 = [get_id2(X) | N],
94    gen_head(G2, N2, X),
95    gen(G2, N2, get_body(X)),
96    foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end,
97	    X#interface.inherit_body),
98    gen_serv(G2, N, X),
99    G3 = ic_file:filename_pop(G2, erlang),
100    gen(G3, N, Xs);
101
102gen(G, N, [X|Xs]) when is_record(X, const) ->
103%    N2 = [get_id2(X) | N],
104    emit_constant_func(G, X#const.id, X#const.val),
105    gen(G, N, Xs); %% N2 or N?
106
107gen(G, N, [X|Xs]) when is_record(X, op) ->
108    {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
109
110    case getNocType(G,X,N) of
111	transparent ->
112	    emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs);
113	multiple ->
114	    mark_not_transparent(G,N),
115	    emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs);
116	_XTuple ->
117	    mark_not_transparent(G,N),
118	    emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs)
119    end,
120
121    gen(G, N, Xs);
122
123
124gen(G, N, [X|Xs]) when is_record(X, attr) ->
125    emit_attr(G, N, X, fun emit_stub_func/7),
126    gen(G, N, Xs);
127
128gen(G, N, [X|Xs]) when is_record(X, except) ->
129    icstruct:except_gen(G, N, X, erlang),
130    gen(G, N, Xs);
131
132gen(G, N, [X|Xs]) ->
133    case may_contain_structs(X) of
134	true -> icstruct:struct_gen(G, N, X, erlang);
135	false -> ok
136    end,
137    gen(G, N, Xs);
138
139gen(_G, _N, []) -> ok.
140
141
142may_contain_structs(X) when is_record(X, typedef) -> true;
143may_contain_structs(X) when is_record(X, struct) -> true;
144may_contain_structs(X) when is_record(X, union) -> true;
145may_contain_structs(_X) -> false.
146
147
148
149%%--------------------------------------------------------------------
150%%
151%% Generate the server side (handle_call and handle_cast)
152%%
153
154gen_serv(G, N, X) ->
155    case ic_genobj:is_stubfile_open(G) of
156	true ->
157	    emit_serv_std(G, N, X),
158	    N2 = [get_id2(X) | N],
159	    gen_calls(G, N2, get_body(X)),
160	    lists:foreach(fun({_Name, Body}) ->
161				  gen_calls(G, N2, Body) end,
162			  X#interface.inherit_body),
163	    get_if_gen(G, N2, X),
164	    gen_end_of_call(G, N, X),		% Note N instead of N2
165
166	    gen_casts(G, N2, get_body(X)),
167	    lists:foreach(fun({_Name, Body}) ->
168				  gen_casts(G, N2, Body) end,
169			  X#interface.inherit_body),
170	    gen_end_of_cast(G, N, X),		% Note N instead of N2
171	    emit_skel_footer(G, N, X);		% Note N instead of N2
172	false ->
173	    ok
174    end.
175
176gen_calls(G, N, [X|Xs]) when is_record(X, op) ->
177    case is_oneway(X) of
178	false ->
179	    {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
180	    emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs),
181	    gen_calls(G, N, Xs);
182	true ->
183	    gen_calls(G, N, Xs)
184    end;
185
186gen_calls(G, N, [X|Xs]) when is_record(X, attr) ->
187    emit_attr(G, N, X, fun emit_skel_func/7),
188    gen_calls(G, N, Xs);
189
190gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs);
191gen_calls(_G, _N, []) -> ok.
192
193gen_casts(G, N, [X|Xs]) when is_record(X, op) ->
194    case is_oneway(X) of
195	true ->
196	    {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
197	    emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs),
198	    gen_casts(G, N, Xs);
199	false ->
200	    gen_casts(G, N, Xs)
201    end;
202
203gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs);
204gen_casts(_G, _N, []) -> ok.
205
206emit_attr(G, N, X, F) ->
207    XX = #id_of{type=X},
208    {GetType, SetType} = mk_attr_func_types(N, X),
209    lists:foreach(fun(Id) ->
210			  X2 = XX#id_of{id=Id},
211			  {Get, Set} = mk_attr_func_names(N, get_id(Id)),
212			  F(G, N, X2, Get, [], GetType, []),
213			  case X#attr.readonly of
214			      {readonly, _} -> ok;
215			      _ ->
216				  F(G, N, X2, Set, [mk_name(G, "Value")],
217				    SetType, [])
218			  end end, ic_forms:get_idlist(X)).
219
220
221extract_info(G, _N, X) when is_record(X, op) ->
222    Name	= get_id2(X),
223    InArgs	= ic:filter_params([in,inout], X#op.params),
224    OutArgs	= ic:filter_params([out,inout], X#op.params),
225    ArgNames	= mk_erl_vars(G, InArgs),
226    TypeList	= {ic_forms:get_tk(X),
227		   map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs),
228		   map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs)
229		  },
230    {Name, ArgNames, TypeList, OutArgs}.
231
232
233
234
235emit_serv_std(G, N, X) ->
236    Fd = ic_genobj:stubfiled(G),
237    case transparent(G) of
238	true ->
239	    true;
240	_XTupleORMultiple ->
241	    Impl	= getImplMod(G,X,[get_id2(X)|N]),
242	    TypeID = ictk:get_IR_ID(G, N, X),
243
244	    nl(Fd), nl(Fd), nl(Fd),
245	    ic_codegen:mcomment(Fd, ["Server implementation."]),
246	    nl(Fd), nl(Fd),
247	    ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]),
248	    nl(Fd),
249	    emit(Fd, "typeID() ->\n"),
250	    emit(Fd, "    \"~s\".\n", [TypeID]),
251	    nl(Fd), nl(Fd),
252	    ic_codegen:mcomment(Fd, ["Server creation functions."]),
253	    nl(Fd),
254	    emit(Fd, "oe_create() ->\n"),
255	    emit(Fd, "    start([], []).\n", []),
256	    nl(Fd),
257	    emit(Fd, "oe_create_link() ->\n"),
258	    emit(Fd, "    start_link([], []).\n", []),
259	    nl(Fd),
260	    emit(Fd, "oe_create(Env) ->\n"),
261	    emit(Fd, "    start(Env, []).\n", []),
262	    nl(Fd),
263	    emit(Fd, "oe_create_link(Env) ->\n"),
264	    emit(Fd, "    start_link(Env, []).\n", []),
265	    nl(Fd),
266	    emit(Fd, "oe_create(Env, RegName) ->\n"),
267	    emit(Fd, "    start(RegName, Env, []).\n", []),
268	    nl(Fd),
269	    emit(Fd, "oe_create_link(Env, RegName) ->\n"),
270	    emit(Fd, "    start_link(RegName, Env, []).\n", []),
271	    nl(Fd),
272	    ic_codegen:mcomment(Fd, ["Start functions."]),
273	    nl(Fd),
274	    emit(Fd, "start(Env, Opt) ->\n"),
275	    emit(Fd, "    gen_server:start(?MODULE, Env, Opt).\n"),
276	    nl(Fd),
277	    emit(Fd, "start_link(Env, Opt) ->\n"),
278	    emit(Fd, "    gen_server:start_link(?MODULE, Env, Opt).\n"),
279	    nl(Fd),
280	    emit(Fd, "start(RegName, Env, Opt) ->\n"),
281	    emit(Fd, "    gen_server:start(RegName, ?MODULE, Env, Opt).\n"),
282	    nl(Fd),
283	    emit(Fd, "start_link(RegName, Env, Opt) ->\n"),
284	    emit(Fd, "    gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"),
285	    nl(Fd),
286	    ic_codegen:comment(Fd, "Call to implementation init"),
287	    emit(Fd, "init(Env) ->\n"),
288	    emit(Fd, "    ~p:~p(Env).\n", [Impl, init]),
289	    nl(Fd),
290	    emit(Fd, "terminate(Reason, State) ->\n"),
291	    emit(Fd, "    ~p:~p(Reason, State).\n",
292		 [Impl, terminate]),
293            nl(Fd),
294	    emit(Fd, "code_change(_OldVsn, State, _Extra) ->\n"),
295	    emit(Fd, "    {ok, State}.\n"),
296	    nl(Fd), nl(Fd)
297    end,
298    Fd.
299
300
301
302
303gen_end_of_call(G, _N, _X) ->
304    case transparent(G) of
305	true ->
306	    true;
307	_XTuple ->
308	    Fd = ic_genobj:stubfiled(G),
309	    nl(Fd), nl(Fd),
310	    ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]),
311	    emit(Fd, "handle_call(stop, _From, State) ->\n"),
312	    emit(Fd, "    {stop, normal, ok, State}"),
313	    case get_opt(G, serv_last_call) of
314		exception ->
315		    emit(Fd, ";\n"),
316		    nl(Fd),
317		    emit(Fd, "handle_call(_Req, _From, State) ->\n"),
318		    emit(Fd, "    {reply, ~p, State}.\n",[getCallErr()]);
319		exit ->
320		    emit(Fd, ".\n"),
321		    nl(Fd),
322		    nl(Fd)
323	    end
324    end,
325    ok.
326
327
328gen_end_of_cast(G, _N, _X) ->
329    case transparent(G) of
330	true ->
331	    true;
332	_XTuple ->
333	    Fd = ic_genobj:stubfiled(G),
334	    nl(Fd), nl(Fd),
335	    ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]),
336	    emit(Fd, "handle_cast(stop, State) ->\n"),
337	    emit(Fd, "    {stop, normal, State}"),
338	    case get_opt(G, serv_last_call) of
339		exception ->
340		    emit(Fd, ";\n"),
341		    nl(Fd),
342		    emit(Fd, "handle_cast(_Req, State) ->\n"),
343		    emit(Fd, "    {reply, ~p, State}.\n",[getCastErr()]);
344		exit ->
345		    emit(Fd, ".\n"),
346		    nl(Fd), nl(Fd)
347	    end
348    end,
349    ok.
350
351
352emit_skel_footer(G, N, X) ->
353    case transparent(G) of
354	true ->
355	    true;
356	_XTuple ->
357	    Fd = ic_genobj:stubfiled(G),
358	    nl(Fd), nl(Fd),
359	    ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]),
360	    case use_impl_handle_info(G, N, X) of
361		true ->
362                    emit(Fd, "handle_info(X, State) ->\n"),
363		    emit(Fd, "    ~p:handle_info(X, State).\n\n",
364			 [list_to_atom(ic_genobj:impl(G))]);
365		false ->
366                    emit(Fd, "handle_info(_X, State) ->\n"),
367		    emit(Fd, "    {reply, ~p, State}.\n\n",[getInfoErr()])
368	    end
369    end,
370    ok.
371
372
373use_impl_handle_info(G, N, X) ->
374    FullName = ic_util:to_colon([get_id2(X) | N]),
375    case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of
376	{_, force_false} -> false;
377	{false, false} -> false;
378	_ -> true
379    end.
380
381
382use_timeout(G, N, _X) ->
383    FullName = ic_util:to_colon(N),
384    case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of
385	{_, force_false} -> false;
386	{false, false} -> false;
387	_ -> true
388    end.
389
390
391get_if_name(G) -> mk_oe_name(G, "get_interface").
392
393
394%% Generates the get_interface function (for Lars)
395get_if_gen(G, N, X) ->
396    case transparent(G) of
397	true ->
398	    ok;
399	_XTuple ->
400	    case ic_genobj:is_stubfile_open(G) of
401		true ->
402		    IFC_TKS = tk_interface_data(G,N,X),
403		    Fd = ic_genobj:stubfiled(G),
404		    Name = to_atom(get_if_name(G)),
405
406		    ic_codegen:mcomment_light(Fd,
407					 [io_lib:format("Standard Operation: ~p",
408							[Name])]),
409
410		    emit(Fd, "handle_call({_~s, ~p, []}, _From, State) ->~n",
411			 [mk_name(G, "Ref"), Name]),
412		    emit(Fd, "    {reply, ~p, State};~n", [IFC_TKS]),
413		    nl(Fd),
414		    ok;
415
416		false -> ok
417	    end
418    end.
419
420
421get_if(G,N,[X|Rest]) when is_record(X, op) ->
422    R = ic_forms:get_tk(X),
423    IN = lists:map(fun(P) -> ic_forms:get_tk(P) end,
424		   ic:filter_params([in, inout], X#op.params)),
425    OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end,
426		    ic:filter_params([out, inout], X#op.params)),
427    case print_tk(G,N,X) of
428	true ->
429	    [{get_id2(X), {R, IN, OUT}} | get_if(G,N,Rest)];
430	false ->
431	    get_if(G,N,Rest)
432    end;
433
434get_if(G,N,[X|Rest]) when is_record(X, attr) -> %% Attributes not handled so far <<<<<<<<<<<<<<<<<<<<<<<<
435    {GetT, SetT} = mk_attr_func_types([], X),
436    AList = lists:map(fun(Id) ->
437			      {Get, Set} = mk_attr_func_names([], get_id(Id)),
438			      case X#attr.readonly of
439				  {readonly, _} ->
440				      {Get, GetT};
441				  _ ->
442				      [{Set, SetT}, {Get, GetT}]
443			      end end, ic_forms:get_idlist(X)),
444    lists:flatten(AList) ++ get_if(G,N,Rest);
445
446get_if(G,N,[_X|Rest]) -> get_if(G,N,Rest);
447get_if(_,_,[]) -> [].
448
449
450
451
452%%------------------------------------------------------------
453%%
454%% Export stuff
455%%
456%%	Gathering of all names that should be exported from a stub
457%%	file.
458%%
459
460
461gen_head_special(G, N, X) when is_record(X, interface) ->
462    Fd = ic_genobj:stubfiled(G),
463    NocType = getNocType(G,X,N),
464
465    foreach(fun({Name, Body}) ->
466		    ic_codegen:comment(Fd, "Exports from ~p",
467				  [ic_util:to_colon(Name)]),
468		    ic_codegen:export(Fd, exp_top(G, N, Body, NocType, [])),
469		    nl(Fd)
470	    end, X#interface.inherit_body),
471
472    case transparent(G) of
473	true ->
474	    nl(Fd), nl(Fd);
475	_XTuple ->
476	    ic_codegen:comment(Fd, "Type identification function"),
477	    ic_codegen:export(Fd, [{typeID, 0}]),
478	    nl(Fd),
479	    ic_codegen:comment(Fd, "Used to start server"),
480	    ic_codegen:export(Fd, [{start, 2},{start_link, 3}]),
481	    ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1},
482			      {oe_create_link, 1},{oe_create, 2}, {oe_create_link, 2}]),
483	    nl(Fd),
484	    ic_codegen:comment(Fd, "gen server export stuff"),
485	    emit(Fd, "-behaviour(gen_server).\n"),
486	    ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {code_change, 3},
487                                   {handle_call, 3}, {handle_cast, 2}, {handle_info, 2}]),
488	    nl(Fd), nl(Fd),
489	    ic_codegen:mcomment(Fd, ["Object interface functions."]),
490	    nl(Fd), nl(Fd), nl(Fd)
491    end,
492    Fd;
493
494
495gen_head_special(_G, _N, _X) -> ok.
496
497
498
499%% Shall generate all export declarations
500gen_head(G, N, X) ->
501    case ic_genobj:is_stubfile_open(G) of
502	true ->
503	    F = ic_genobj:stubfiled(G),
504	    ic_codegen:comment(F, "Interface functions"),
505	    ic_codegen:export(F, exp_top(G, N, X, getNocType(G,X,N), [])),
506	    nl(F),
507	    gen_head_special(G, N, X);
508	false -> ok
509    end.
510
511exp_top(_G, _N, X, _NT, Acc)  when element(1, X) == preproc ->
512    Acc;
513exp_top(G, N, L, NT, Acc)  when is_list(L) ->
514    exp_list(G, N, L, NT, Acc);
515exp_top(G, N, M, NT, Acc)  when is_record(M, module) ->
516    exp_list(G, N, get_body(M), NT, Acc);
517exp_top(G, N, I, NT, Acc)  when is_record(I, interface) ->
518    exp_list(G, N, get_body(I), NT, Acc);
519exp_top(G, N, X, NT, Acc) ->
520    exp3(G, N, X, NT, Acc).
521
522exp3(_G, _N, C, _NT, Acc)  when is_record(C, const) ->
523    [{get_id(C#const.id), 0} | Acc];
524
525exp3(G, N, Op, NocType, Acc)  when is_record(Op, op) ->
526    FuncName = get_id(Op#op.id),
527
528    TA = case use_timeout(G,N,Op) of
529	     true ->
530		 1;
531	     false ->
532		 0
533	 end,
534
535    case NocType of
536	transparent ->
537	    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
538	    [{FuncName, Arity} | Acc];
539	multiple ->
540	    case getModType(G, Op, N) of
541		dt ->
542		    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
543		    [{FuncName, Arity} | Acc];
544		do ->
545		    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
546		    [{FuncName, Arity} | Acc];
547		spt ->
548		    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
549		    [{FuncName, Arity} | Acc];
550		spo ->
551		    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
552		    [{FuncName, Arity} | Acc]
553	    end;
554	_ ->
555	    Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
556	    [{FuncName, Arity} | Acc]
557    end;
558exp3(_G, _N, A, _NT, Acc)  when is_record(A, attr) ->
559    lists:foldr(fun(Id, Acc2) ->
560			{Get, Set} = mk_attr_func_names([], get_id(Id)),
561			case A#attr.readonly of
562			    {readonly, _} -> [{Get, 1} | Acc2];
563			    _ ->             [{Get, 1}, {Set, 2} | Acc2]
564			end end, Acc, ic_forms:get_idlist(A));
565
566exp3(_G, _N, _X, _NT, Acc) -> Acc.
567
568exp_list(G, N, L, NT, OrigAcc) ->
569    lists:foldr(fun(X, Acc) -> exp3(G, N, X, NT, Acc) end, OrigAcc, L).
570
571
572
573
574%%------------------------------------------------------------
575%%
576%% Emit stuff
577%%
578%%	Low level generation primitives
579%%
580
581emit_stub_func(G, N, X, Name, ArgNames, TypeList, _OutArgs) ->
582    case ic_genobj:is_stubfile_open(G) of
583	false -> ok;
584	true ->
585	    Fd = ic_genobj:stubfiled(G),
586	    StubName = list_to_atom(Name),
587	    This = mk_name(G, "Ref"),
588	    XTuple = getNocType(G,X,N),
589	    CallOrCast =
590		case is_oneway(X) of
591		    true -> ?CAST;
592		    _ -> ?CALL
593		end,
594
595	    %% Type expand operation on comments
596	    ic_code:type_expand_op(G,N,X,Fd),
597
598	    case use_timeout(G,N,X) of
599		true ->
600		    Timeout = mk_name(G,"Timeout"),
601		    emit(Fd, "~p(~s) ->\n",
602			 [StubName, mk_list([This, Timeout| ArgNames])]),
603		    emit(Fd, "    ~p:~s(~s, ~s, ?MODULE, ~p, ~p, [~s], ~p).\n\n",
604			 [getImplMod(G,X,N),
605			  CallOrCast,
606			  This,
607			  Timeout,
608			  XTuple,
609			  StubName,
610			  mk_list(ArgNames),
611			  tk_operation_data(G, N, X, TypeList)]);
612		false ->
613		    emit(Fd, "~p(~s) ->\n",
614			 [StubName, mk_list([This | ArgNames])]),
615
616		    emit(Fd, "    ~p:~s(~s, ~p, ?MODULE, ~p, [~s], ~p).\n\n",
617			 [getImplMod(G,X,N),
618			  CallOrCast,
619			  This,
620			  XTuple,
621			  StubName,
622			  mk_list(ArgNames),
623			  tk_operation_data(G, N, X, TypeList)])
624	    end
625    end.
626
627
628emit_transparent_func(G, N, X, Name, ArgNames, _TypeList, _OutArgs) ->
629    case ic_genobj:is_stubfile_open(G) of
630	false -> ok;
631	true ->
632	    Fd = ic_genobj:stubfiled(G),
633	    OpName = list_to_atom(Name),
634
635	    ArgList = case use_timeout(G,N,X) of
636			  true ->
637			      mk_list([mk_name(G,"Ref"),mk_name(G,"Timeout")|ArgNames]);
638			  false ->
639			       mk_list([mk_name(G,"Ref")|ArgNames])
640		      end,
641
642	    %% Type expand operation on comments
643	    ic_code:type_expand_op(G,N,X,Fd),
644
645	    emit(Fd, "~p(~s) ->\n", [OpName,ArgList]),
646	    emit(Fd, "    ~p:~s(~s).\n\n", [getImplMod(G,X,N), OpName, ArgList])
647    end.
648
649
650
651
652
653
654emit_skel_func(G, N, X, OpName, ArgNames, _TypeList, _OutArgs) ->
655    case getNocType(G,X,N) of
656	transparent ->
657	    true;
658	multiple ->
659	    true;
660	XTuple ->
661	    case ic_genobj:is_stubfile_open(G) of
662		false -> ok;
663		true ->
664		    Fd = ic_genobj:stubfiled(G),
665		    Name	= list_to_atom(OpName),
666		    This	= mk_name(G, "Ref"),
667		    From	= mk_name(G, "From"),
668		    State	= mk_name(G, "State"),
669
670		    %% Type expand handle operation on comments
671		    ic_code:type_expand_handle_op(G,N,X,Fd),
672
673		    case is_oneway(X) of
674			true ->
675			    emit(Fd, "handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s) ->\n",
676				 [This, XTuple, Name, mk_list(ArgNames), State]),
677			    emit(Fd, "    ~p:handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s);\n\n",
678				 [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), State]);
679			false ->
680			    emit(Fd, "handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s) ->\n",
681				 [This, XTuple, Name, mk_list(ArgNames), From, State]),
682			    emit(Fd, "    ~p:handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s);\n\n",
683				 [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), From, State])
684		    end
685	    end
686    end.
687
688
689
690emit_constant_func(G, Id, Val) ->
691    case ic_genobj:is_stubfile_open(G) of
692	false -> ok;
693	true ->
694	    Fd = ic_genobj:stubfiled(G),
695	    N = list_to_atom(get_id(Id)),
696	    emit_const_comment(G, Fd, Id, N),
697	    emit(Fd, "~p() -> ~p.\n\n", [N, Val])
698    end.
699
700
701emit_const_comment(_G, F, _X, Name) ->
702    ic_codegen:mcomment_light(F,
703			 [io_lib:format("Constant: ~p", [Name])]).
704
705%%------------------------------------------------------------
706%%
707%% Utilities
708%%
709%% Convenient little go-get functions
710%%
711%%------------------------------------------------------------
712
713%% The automaticly generated get and set operation names for an
714%% attribute.
715mk_attr_func_names(_Scope, Name) ->
716    {"_get_" ++ Name, "_set_" ++ Name}.
717
718%% Returns TK of the Get and Set attribute functions.
719mk_attr_func_types(_N, X) ->
720    TK = ic_forms:get_tk(X),
721    {{TK, [], []}, {tk_void, [TK], []}}.
722
723
724
725%%------------------------------------------------------------
726%%
727%% Generation utilities and common stuff
728%%
729%% Convenient stuff for generation
730%%
731%%------------------------------------------------------------
732
733
734%% Input is a list of parameters (in parse form) and output is a list
735%% of capitalised variable names. mk_var is in icgen
736mk_erl_vars(_G, Params) ->
737    map(fun(P) -> mk_var(get_id(P#param.id)) end, Params).
738
739
740%% mk_list produces a nice comma separated string of variable names
741mk_list([]) -> [];
742mk_list([Arg | Args]) ->
743    Arg ++ mk_list2(Args).
744mk_list2([Arg | Args]) ->
745    ", " ++ Arg ++ mk_list2(Args);
746mk_list2([]) -> [].
747
748
749%%------------------------------------------------------------
750%%
751%% Parser utilities
752%%
753%% Called from the yecc parser. Expands the identifier list of an
754%% attribute so that the attribute generator never has to handle
755%% lists.
756%%
757%%------------------------------------------------------------
758
759
760%% Unfold identifier lists or nested lists. Note that many records
761%% contain an entry named id that is a list before unfold and a single
762%% id afterwards.
763unfold(L) when is_list(L) ->
764    lists:flatten(map(fun(X) -> unfold2(X) end, L));
765unfold(X) -> unfold2(X).
766
767unfold2(A) when is_record(A, attr) ->
768    map(fun(Id) -> A#attr{id=Id} end, A#attr.id);
769unfold2(M) when is_record(M, member) ->
770    map(fun(Id) -> M#member{id=Id} end, M#member.id);
771unfold2(M) when is_record(M, case_dcl) ->
772    map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label);
773unfold2(T) when is_record(T, typedef) ->
774    map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id   ).
775
776
777
778
779
780
781%% Export code produce for dependency function
782exportDependency(G) ->
783    Fd = ic_genobj:stubfiled(G),
784    ic_codegen:export(Fd, [{oe_dependency, 0}]),
785    nl(Fd).
786
787%% Code produce for dependency function
788genDependency(G) ->
789    Fd = ic_genobj:stubfiled(G),
790    nl(Fd),nl(Fd),
791    ic_codegen:comment(Fd, "Idl file dependency list function"),
792    emit(Fd, "oe_dependency() ->\n", []),
793    emit(Fd, "    ~p.\n\n", [ic_pragma:get_dependencies(G)]).
794
795
796
797
798
799%%%%%%
800
801
802getImplMod(G,X,Scope) -> %% to_atom(ic_genobj:impl(G)) | ChoicedModuleName
803
804    %% Get actual pragma appliance scope
805    SpecScope = getActualScope(G,X,Scope),
806
807    %% The "broker" option is passed
808    %% only by pragmas, seek for module.
809    case ic_pragma:getBrokerData(G,X,SpecScope) of
810	{Module,_Type} ->
811	    Module;
812	_List ->
813	    element(1,ic_pragma:defaultBrokerData(G))
814    end.
815
816
817getNocType(G,X,Scope) when is_record(X, interface) -> %% default | specified
818    OpList = getAllOperationScopes(G,Scope),
819    getNocType2(G,X,OpList);
820getNocType(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN}
821    getNocType3(G,X,Scope).
822
823getNocType2(G,X,List) ->
824    getNocType2(G,X,List,[]).
825
826getNocType2(_,_,[],Found) ->
827    selectTypeFromList(Found);
828getNocType2(G,X,[OpScope|OpScopes],Found) ->
829    getNocType2(G,X,OpScopes,[getNocType3(G,X,OpScope)|Found]).
830
831getNocType3(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN}
832
833    %% Get actual pragma appliance scope
834    SpecScope = getActualScope(G,X,Scope),
835
836    %% The "broker" option is passed
837    %% only by pragmas, seek for type.
838    case ic_pragma:getBrokerData(G,X,SpecScope) of
839	{_Module,Type} ->
840	    Type;
841	List ->
842	    selectTypeFromList(List) %%transparent/multiple
843    end.
844
845
846getModType(G,X,Scope) -> %% default | specified
847
848    %% Get actual pragma appliance scope
849    SpecScope = getActualScope(G,X,Scope),
850
851    %% The "broker" option is passed
852    %% only by pragmas, seek for brokerdata.
853    case ic_pragma:getBrokerData(G,X,SpecScope) of
854	{Module,Type} ->
855	    case Module == ic_genobj:impl(G) of
856		true ->
857		    case Type of
858			transparent ->
859			    dt; %% default + transparent
860			_ ->
861			    do  %% default + opaque
862		    end;
863		false ->
864		    case Type of
865			transparent ->
866			    spt; %% specified + transparent
867			_ ->
868			    spo  %% specified + opaque
869		    end
870	    end;
871	_List ->
872	    dt
873    end.
874
875
876
877%%%%
878%%
879%% Returns a list of ALL operation full
880%% scoped names local and inherited
881%% from other interfaces
882%%
883
884getAllOperationScopes(G,Scope) ->
885    getOperationScopes(G,Scope) ++
886	getInhOperationScopes(G,Scope).
887
888
889getOperationScopes(G,Scope) ->
890    getOpScopes(G,
891		Scope,
892		ets:match(ic_genobj:pragmatab(G),{op,'$0',Scope,'_','_'}),
893		[]).
894
895getOpScopes(_,_,[],OpScopes) ->
896    OpScopes;
897getOpScopes(G,Scope,[[Name]|Names],Found) ->
898    getOpScopes(G,Scope,Names,[[Name|Scope]|Found]).
899
900
901getInhOperationScopes(G,Scope) ->
902    getInhOpScopes1(G,
903		   Scope,
904		   ets:match(ic_genobj:pragmatab(G),{inherits,Scope,'$1'}),
905		   []).
906
907getInhOpScopes1(G,_Scope,[],OpScopes) ->
908    getInhOpScopes2(G,OpScopes);
909getInhOpScopes1(G,Scope,[[SC]|SCs],Found) ->
910    getInhOpScopes1(G,Scope,SCs,[SC|Found]).
911
912
913getInhOpScopes2(G,Scopes) ->
914    getInhOpScopes2(G,Scopes,[]).
915
916getInhOpScopes2(_G,[],Found) ->
917    Found;
918getInhOpScopes2(G,[SC|SCs],Found) ->
919   getOperationScopes(G,SC) ++ getInhOpScopes2(G,SCs,Found).
920
921%%
922%%
923%%%%
924
925
926
927%%%%
928%%
929%%
930%% Seek the actual operation scope :
931%%
932%%   * if the operation is inherited, get the real scope for it
933%%
934%%   * if the operation has a specific pragma, apply the real
935%%     scope, otherwise return the including scope
936%%
937getActualScope(G, X, Scope) when is_record(X, op) ->
938    OpScope = getRealOpScope(G,X,Scope),
939    case ets:match(ic_genobj:pragmatab(G),{codeopt_specific,OpScope}) of
940	[[]] ->
941	    OpScope;
942	_ ->
943	    Scope
944    end;
945getActualScope(_G, _X, N) ->
946    N.
947
948%%
949%%  Just seek and return the scope for the operation
950%%  where it were originaly defined
951%%
952getRealOpScope(G,X,N) when is_record(X, op) ->
953    Ptab = ic_genobj:pragmatab(G),
954    Id = get_id2(X),
955
956    case ets:match(Ptab,{op,Id,N,'_','_'}) of
957	[[]] ->
958	    [Id|N];
959	_ ->
960	    getRealOpScope(G, Ptab, X, N, Id,  ets:match(Ptab,{inherits,N,'$1'}))
961    end;
962getRealOpScope(_G,_X,N) ->
963    N.
964
965getRealOpScope(_G, _S, _X, N, Id, []) ->
966    [Id|N];
967getRealOpScope(G, S, X, N, Id, [[OS]|OSs]) ->
968    case ets:match(S,{op,Id,OS,'_','_'}) of
969	[[]] ->
970	    [Id|OS];
971	_ ->
972	    getRealOpScope(G, S, X, N, Id, OSs)
973    end.
974
975selectTypeFromList([]) ->
976    transparent;
977selectTypeFromList([{_,transparent}|Rest]) ->
978    selectTypeFromList(Rest);
979selectTypeFromList([transparent|Rest]) ->
980    selectTypeFromList(Rest);
981selectTypeFromList([_|_Rest]) ->
982    multiple.
983
984
985
986getCallErr() ->
987    {'ERROR' ,"Bad Operation -- handle call"}.
988
989getCastErr() ->
990    {'ERROR' ,"Bad Operation -- handle cast"}.
991
992getInfoErr() ->
993    {'ERROR' ,"Bad Operation -- handle info"}.
994
995
996
997
998
999
1000%%
1001%% Type code access utilities
1002%%
1003
1004tk_operation_data(G, N, X, TL) ->
1005    case print_tk(G,N,X) of
1006	true ->
1007	    TL;
1008	false ->
1009	    no_tk
1010    end.
1011
1012tk_interface_data(G, N, X) ->
1013    InfoList =
1014	foldr(fun({_Name, Body}, Acc) ->
1015		      get_if(G,N,Body)++Acc end,
1016	      get_if(G,N,get_body(X)),
1017	      X#interface.inherit_body),
1018    case InfoList of
1019	[] ->
1020	    no_tk;  %%%%%%%% Should be changed to [] <<<<<<<<<<<<<<<<<<<<<<<<<<< Warning !
1021	_ ->
1022	    InfoList
1023    end.
1024
1025
1026print_tk(G, N, X) when is_record(X, op)-> %% operation
1027    case getNocType(G,X,N) of
1028	transparent ->
1029	    false;
1030	multiple ->
1031	    false;
1032	_XTuple -> %%check if there are any USETK pragmas
1033	    operation_usetk(G,N,X)
1034    end;
1035print_tk(_G, _N, _X) -> %% error
1036    false.
1037
1038
1039operation_usetk(G,N,X) ->
1040    PTab = ic_genobj:pragmatab(G),
1041    OTab = ic_genobj:optiontab(G),
1042    OpName = get_id2(X),
1043%    SID = ic_util:to_colon(N),
1044    Res = case use_tk(OTab,[N]) of
1045	      {ok,N} ->
1046		  true;
1047	      false ->
1048		  %% Look if there is an operation with that name
1049                  %% which can be found in an included file.
1050		  case ets:match(PTab,{file_data_included,'_','_',op,'$3',OpName,'_','_','_'}) of
1051		      [] ->
1052			  false;
1053		      ScopeList ->
1054			  case use_tk(OTab,ScopeList) of
1055			      %% There is an operation with that name,
1056			      %% look if it is inherited by interface "N"
1057			      {ok,FoundScope} ->
1058				  ic_pragma:is_inherited_by(FoundScope,N,PTab);
1059			      false ->
1060				  false
1061			  end
1062		  end
1063	  end,
1064    Res.
1065
1066
1067use_tk(_,[]) ->
1068    false;
1069use_tk(OTab,[[Scope]|Scopes]) ->
1070    SID = ic_util:to_colon(Scope),
1071    case ets:match(OTab,{{option,{use_tk,SID}},true}) of
1072	[] ->
1073	    case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of
1074		[] ->
1075		    use_tk(OTab,Scopes);
1076		_ ->
1077		    {ok,Scope}
1078	    end;
1079	_ ->
1080	    {ok,Scope}
1081    end;
1082use_tk(OTab,[Scope|Scopes]) ->
1083    SID = ic_util:to_colon(Scope),
1084    case ets:match(OTab,{{option,{use_tk,SID}},true}) of
1085	[] ->
1086	    case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of
1087		[] ->
1088		    use_tk(OTab,Scopes);
1089		_ ->
1090		    {ok,Scope}
1091	    end;
1092	_ ->
1093	    {ok,Scope}
1094    end.
1095
1096
1097
1098
1099
1100mark_not_transparent(G,N) ->
1101
1102    %% Mark that there are multiple
1103    %% functions in interface
1104    S = ic_genobj:pragmatab(G),
1105    ets:insert(S,{no_transparent,N}).
1106
1107
1108transparent(G) ->
1109
1110    S = ic_genobj:pragmatab(G),
1111    case ets:match_object(S,{no_transparent,'$0'}) of
1112	[] ->
1113	    true;
1114	_ ->
1115	    false
1116    end.
1117
1118