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
22-module(ic_forms).
23
24-include_lib("ic/src/ic.hrl").
25-include_lib("ic/src/icforms.hrl").
26
27%%-----------------------------------------------------------------
28%% External exports
29%%-----------------------------------------------------------------
30-export([get_id/1, get_id2/1, get_java_id/1, get_line/1]).
31-export([get_type_code/3, search_tk/2, clean_up_scope/1]).
32-export([get_body/1, get_dimension/1, get_idlist/1, get_type/1, get_tk/1, is_oneway/1]).
33
34%%-----------------------------------------------------------------
35%% Internal exports
36%%-----------------------------------------------------------------
37-export([]).
38
39%%-----------------------------------------------------------------
40%% External functions
41%%-----------------------------------------------------------------
42
43%%--------------------------------------------------------------------
44%%
45%% Generation go-get utilities
46%%
47%%	Feeble attempt at virtual funtions.
48%%
49%%--------------------------------------------------------------------
50
51get_dimension(X) when is_record(X, array)       ->
52    [element(3, L) || L <- X#array.size].
53
54%% Should find the name hidden in constructs
55get_id( [{'<identifier>', _LineNo, Id}] ) -> Id;
56get_id( {'<identifier>', _LineNo, Id} ) -> Id;
57get_id(Id) when is_list(Id) andalso is_integer(hd(Id)) -> Id;
58get_id(X) when is_record(X, scoped_id) -> X#scoped_id.id;
59get_id(X) when is_record(X, array) -> get_id(X#array.id);
60get_id( {'<string_literal>', _LineNo, Id} ) -> Id;
61get_id( {'<wstring_literal>', _LineNo, Id} ) -> Id.
62
63get_line([{'<identifier>', LineNo, _Id}]) -> LineNo;
64get_line({'<identifier>', LineNo, _Id}) -> LineNo;
65get_line(X) when is_record(X, scoped_id) -> X#scoped_id.line;
66get_line(X) when is_record(X, module)      -> get_line(X#module.id);
67get_line(X) when is_record(X, interface)   -> get_line(X#interface.id);
68get_line(X) when is_record(X, forward)     -> get_line(X#forward.id);
69get_line(X) when is_record(X, constr_forward) -> get_line(X#constr_forward.id);
70get_line(X) when is_record(X, const)       -> get_line(X#const.id);
71get_line(X) when is_record(X, typedef)     -> get_line(X#typedef.id);
72get_line(X) when is_record(X, struct)      -> get_line(X#struct.id);
73get_line(X) when is_record(X, member)      -> get_line(X#member.id);
74get_line(X) when is_record(X, union)       -> get_line(X#union.id);
75get_line(X) when is_record(X, case_dcl)    -> get_line(X#case_dcl.id);
76get_line(X) when is_record(X, enum)	-> get_line(X#enum.id);
77get_line(X) when is_record(X, enumerator)	-> get_line(X#enumerator.id);
78get_line(X) when is_record(X, array)       -> get_line(X#array.id);
79get_line(X) when is_record(X, attr)	-> get_line(X#attr.id);
80get_line(X) when is_record(X, except)	-> get_line(X#except.id);
81get_line(X) when is_record(X, op)		-> get_line(X#op.id);
82get_line(X) when is_record(X, param)       -> get_line(X#param.id);
83get_line(X) when is_record(X, id_of)       -> get_line(X#id_of.id);
84
85get_line({'or', T1, _T2}) ->	get_line(T1);
86get_line({'xor', T1, _T2}) ->	get_line(T1);
87get_line({'and', T1, _T2}) ->	get_line(T1);
88get_line({'rshift', T1, _T2}) ->get_line(T1);
89get_line({'lshift', T1, _T2}) ->get_line(T1);
90get_line({'+', T1, _T2}) ->	get_line(T1);
91get_line({'-', T1, _T2}) ->	get_line(T1);
92get_line({'*', T1, _T2}) ->	get_line(T1);
93get_line({'/', T1, _T2}) ->	get_line(T1);
94get_line({'%', T1, _T2}) ->	get_line(T1);
95get_line({{'-', _Line}, T}) ->	get_line(T);
96get_line({{'+', _Line}, T}) ->	get_line(T);
97get_line({{'~', _Line}, T}) ->	get_line(T);
98get_line({_, X, _}) when is_integer(X) -> X;
99get_line({_A, N}) when is_integer(N)	-> N;
100get_line(_)				-> -1.
101
102
103%%--------------------------------------------------------------------
104%%
105%% High level get functions.
106%%
107%%	These are highly polymorphic functions that will get the id,
108%%	body and type of a record (those records output from the
109%%	parser).
110%%
111%% NOTE: The typedef node (the alias) is special, because the type
112%%	field is a type definition and therefore considered a body,
113%%	and the type of a typedef is its name.
114%%
115
116get_id2(X) when is_record(X, module)       -> get_id(X#module.id);
117get_id2(X) when is_record(X, interface)    -> get_id(X#interface.id);
118get_id2(X) when is_record(X, forward)      -> get_id(X#forward.id);
119get_id2(X) when is_record(X, constr_forward) -> get_id(X#constr_forward.id);
120get_id2(X) when is_record(X, const)        -> get_id(X#const.id);
121get_id2(X) when is_record(X, typedef)      -> get_id(hd(X#typedef.id));
122get_id2(X) when is_record(X, struct)       -> get_id(X#struct.id);
123get_id2(X) when is_record(X, member)       -> get_id(hd(X#member.id));
124get_id2(X) when is_record(X, union)        -> get_id(X#union.id);
125get_id2(X) when is_record(X, case_dcl)     -> get_id(X#case_dcl.id);
126get_id2(X) when is_record(X, enum)		-> get_id(X#enum.id);
127get_id2(X) when is_record(X, enumerator)	-> get_id(X#enumerator.id);
128get_id2(X) when is_record(X, array)        -> get_id(X#array.id);
129get_id2(X) when is_record(X, attr)		-> get_id(X#attr.id);
130get_id2(X) when is_record(X, except)       -> get_id(X#except.id);
131get_id2(X) when is_record(X, op)		-> get_id(X#op.id);
132get_id2(X) when is_record(X, param)        -> get_id(X#param.id);
133get_id2(X) when is_record(X, type_dcl)     -> get_id2(X#type_dcl.type);
134get_id2(X) when is_record(X, scoped_id)	-> ic_symtab:scoped_id_strip(X);
135get_id2(X) when is_record(X, preproc)	-> get_id(X#preproc.id);
136get_id2(X) when is_record(X, id_of)	-> get_id2(X#id_of.id);
137get_id2(X) -> get_id(X).
138
139get_body(X) when is_record(X, module)      -> X#module.body;
140get_body(X) when is_record(X, interface)   -> X#interface.body;
141get_body(X) when is_record(X, struct)      -> X#struct.body;
142get_body(X) when is_record(X, union)       -> X#union.body;
143get_body(X) when is_record(X, enum)        -> X#enum.body;
144get_body(X) when is_record(X, typedef)     -> X#typedef.type; % See Note
145get_body(X) when is_record(X, except)      -> X#except.body.
146
147get_type(X) when is_record(X, const)       -> X#const.type;
148get_type(X) when is_record(X, type_dcl)    -> X#type_dcl.type;
149get_type(X) when is_record(X, typedef)     -> X#typedef.id; % See Note
150get_type(X) when is_record(X, member)      -> X#member.type;
151get_type(X) when is_record(X, union)       -> X#union.type;
152get_type(X) when is_record(X, case_dcl)    -> X#case_dcl.type;
153get_type(X) when is_record(X, sequence)    -> X#sequence.type;
154get_type(X) when is_record(X, attr)        -> X#attr.type;
155get_type(X) when is_record(X, op)		-> X#op.type;
156get_type(X) when is_record(X, param)       -> X#param.type.
157%%get_type(X) when record(X, id_of)       -> get_type(X#id_of.type).
158
159%% Temporary place
160get_tk(X) when is_record(X, interface)  -> X#interface.tk;
161get_tk(X) when is_record(X, forward)    -> X#forward.tk;
162get_tk(X) when is_record(X, constr_forward) -> X#constr_forward.tk;
163get_tk(X) when is_record(X, const)      -> X#const.tk;
164get_tk(X) when is_record(X, type_dcl)   -> X#type_dcl.tk;
165get_tk(X) when is_record(X, typedef)    -> X#typedef.tk;
166get_tk(X) when is_record(X, struct)     -> X#struct.tk;
167get_tk(X) when is_record(X, union)      -> X#union.tk;
168get_tk(X) when is_record(X, enum)       -> X#enum.tk;
169get_tk(X) when is_record(X, attr)       -> X#attr.tk;
170get_tk(X) when is_record(X, except)     -> X#except.tk;
171get_tk(X) when is_record(X, op)         -> X#op.tk;
172get_tk(X) when is_record(X, id_of)      -> X#id_of.tk;
173get_tk(X) when is_record(X, param)      -> X#param.tk.
174
175
176%% Get idlist returns the list of identifiers found in typedefs, case
177%% dcls etc.
178get_idlist(X) when is_record(X, typedef)	-> X#typedef.id;
179get_idlist(X) when is_record(X, member)	-> X#member.id;
180get_idlist(X) when is_record(X, case_dcl)	-> X#case_dcl.label;
181get_idlist(X) when is_record(X, attr)	-> X#attr.id.
182
183
184is_oneway(X) when is_record(X, op)  ->
185    case  X#op.oneway of
186	{oneway, _} -> true;
187	_ -> false
188    end;
189is_oneway(_X) -> false.
190
191
192
193
194
195%%------------------------------------------------------------
196%%
197%% Analyze the record and seek the correct type code.
198%%
199%% NOT equal to get_tk, this will always succed !
200%%
201%%------------------------------------------------------------
202get_type_code(G, N, X) ->
203    case get_type_code2(G, N, X) of
204	undefined ->
205	    %% Remove "Package" suffix from scope
206	    N2 = clean_up_scope(N),
207	    search_tk(G,ictk:get_IR_ID(G, N2, X));
208	TC ->
209	    TC
210    end.
211
212clean_up_scope(N) ->
213    clean_up_scope(N,[]).
214
215clean_up_scope([],N) ->
216    lists:reverse(N);
217clean_up_scope([N|Ns],Found) ->
218    case lists:suffix("Package",N) of
219	true ->
220	    Len = length(N),
221	    case Len > 7 of
222		true ->
223		    N2 = string:substr(N,1,Len-7),
224		    clean_up_scope(Ns,[N2|Found]);
225		false ->
226		    clean_up_scope(Ns,[N|Found])
227	    end;
228	false ->
229	    clean_up_scope(Ns,[N|Found])
230    end.
231
232
233get_type_code2(_, _, X) when is_record(X, interface)  -> X#interface.tk;
234get_type_code2(_, _, X) when is_record(X, forward)    -> X#forward.tk;
235get_type_code2(_, _, X) when is_record(X, constr_forward) -> X#constr_forward.tk;
236get_type_code2(_, _, X) when is_record(X, const)      -> X#const.tk;
237get_type_code2(_, _, X) when is_record(X, type_dcl)   -> X#type_dcl.tk;
238get_type_code2(_, _, X) when is_record(X, typedef)    ->
239    Id = X#typedef.id,
240    ET = X#typedef.tk,
241    if is_list(Id) ->
242	    Head = hd(Id),
243	    if is_tuple(Head) ->
244		    case element(1,Head) of
245			array ->
246			    get_array_tc(ET, element(3,Head));
247			_ ->
248			    ET
249		    end;
250	       true ->
251		    ET
252	    end;
253       true ->
254	    ET
255    end;
256
257get_type_code2(_, _, X) when is_record(X, struct)     -> X#struct.tk;
258get_type_code2(_, _, X) when is_record(X, union)      -> X#union.tk;
259get_type_code2(_, _, X) when is_record(X, enum)       -> X#enum.tk;
260get_type_code2(_, _, X) when is_record(X, attr)       -> X#attr.tk;
261get_type_code2(_, _, X) when is_record(X, except)     -> X#except.tk;
262get_type_code2(_, _, X) when is_record(X, op)         -> X#op.tk;
263get_type_code2(_, _, X) when is_record(X, id_of)      -> X#id_of.tk;
264get_type_code2(_, _, X) when is_record(X, param)      -> X#param.tk;
265
266get_type_code2(G, N, X) when is_record(X, member) ->
267    ET = get_type_code(G, N, element(2,X)),
268    Id = element(3,X),
269
270    if is_list(Id) ->
271	    Head = hd(Id),
272	    if is_tuple(Head) ->
273		    case element(1,Head) of
274			array ->
275			    get_array_tc(ET, element(3,Head));
276			_ ->
277			    ET
278		    end;
279	       true ->
280		    ET
281	    end;
282       true ->
283	    ET
284    end;
285
286get_type_code2(G, N, X) when is_record(X, scoped_id) ->
287    element(3,ic_symtab:get_full_scoped_name(G, N, X));
288
289get_type_code2(G, N, X) when is_record(X, sequence) ->
290    if is_tuple(X#sequence.length) ->
291	    {tk_sequence,
292	     get_type_code(G, N, X#sequence.type),
293	     list_to_integer(element(3,X#sequence.length))};
294       true ->
295	    {tk_sequence,
296	     get_type_code(G, N, X#sequence.type),
297	     X#sequence.length}
298    end;
299
300get_type_code2(_G, _N, {unsigned,{short,_}}) -> tk_ushort;
301
302get_type_code2(_G, _N, {unsigned,{long,_}}) -> tk_ulong;
303
304get_type_code2(_G, _N, {unsigned,{'long long',_}}) -> tk_ulonglong;
305
306get_type_code2(_G, _N, X) when is_record(X, fixed) ->
307    {tk_fixed, X#fixed.digits, X#fixed.scale};
308
309get_type_code2(G, N, {X,_}) ->
310    get_type_code2(G, N, X);
311
312get_type_code2(_, _, short) -> tk_short;
313get_type_code2(_, _, long) -> tk_long;
314get_type_code2(_, _, 'long long') -> tk_longlong;
315get_type_code2(_, _, float) -> tk_float;
316get_type_code2(_, _, double) -> tk_double;
317get_type_code2(_, _, boolean) -> tk_boolean;
318get_type_code2(_, _, char) -> tk_char;
319get_type_code2(_, _, wchar) -> tk_wchar;
320get_type_code2(_, _, octet) -> tk_octet;
321get_type_code2(_, _, string) -> tk_string;
322get_type_code2(_, _, wstring) -> tk_wstring;
323get_type_code2(_, _, any) -> tk_any.
324
325
326get_array_tc(ET, []) ->
327    ET;
328get_array_tc(ET, [L|Ls]) ->
329    {tk_array,
330     get_array_tc(ET,Ls),
331     list_to_integer(element(3,L))}.
332
333
334
335
336%%------------------------------------------------------------
337%%
338%% seek type code when not accessible by ic_forms:get_tk/1 ( should be
339%% a part of "do_gen" related functions later )
340%%
341%%------------------------------------------------------------
342search_tk(G, IR_ID) ->
343    S = ic_genobj:tktab(G),
344    case catch search_tk(S,IR_ID,typedef) of
345	{value,TK} ->
346	    TK;
347	_ -> %% false / exit
348 	    case catch search_tk(S,IR_ID,struct) of
349		{value,TK} ->
350		    TK;
351		_  ->  %% false / exit
352		    case catch search_tk(S,IR_ID,union) of
353			{value,TK} ->
354			    TK;
355			_ ->
356			    undefined
357		    end
358	    end
359    end.
360
361
362search_tk(S, IR_ID, Type) ->
363    L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})),
364    case lists:keysearch(IR_ID,2,L) of
365	{value,TK} ->
366	    {value,TK};
367	false ->
368	    search_inside_tks(L,IR_ID)
369    end.
370
371
372search_inside_tks([],_IR_ID) ->
373    false;
374search_inside_tks([{tk_array,TK,_}|Xs],IR_ID) ->
375    case search_included_tk(TK,IR_ID) of
376	{value,TK} ->
377	    {value,TK};
378	false ->
379	    search_inside_tks(Xs,IR_ID)
380    end.
381
382
383search_included_tk({tk_array,TK,_}, IR_ID) ->
384    search_included_tk(TK,IR_ID);
385search_included_tk({tk_sequence,TK,_}, IR_ID) ->
386    search_included_tk(TK,IR_ID);
387search_included_tk(TK, _IR_ID) when is_atom(TK) ->
388    false;
389search_included_tk(TK, IR_ID) ->
390    case element(2,TK) == IR_ID of
391	true ->
392	    {value,TK};
393	false ->
394	    false
395    end.
396
397
398
399
400%% This is similar to get_id2 but in everything else
401%% than a module it will generate an id prefixed
402get_java_id(Id) when is_list(Id) ->
403    case java_keyword_coalition(Id) of
404	true ->
405	    "_" ++ Id;
406	false ->
407	    Id
408    end;
409get_java_id(Id_atom) when is_atom(Id_atom) ->
410    Id = atom_to_list(Id_atom),
411    case java_keyword_coalition(Id) of
412	true ->
413	    "_" ++ Id;
414	false ->
415	    Id
416    end;
417get_java_id(X) ->
418    Id = get_id2(X),
419    case java_keyword_coalition(Id) of
420	true ->
421	    "_" ++ Id;
422	false ->
423	    Id
424    end.
425
426java_keyword_coalition(Id) ->
427    lists:member(list_to_atom(Id),
428		 [abstract, default, 'if', private, throw, boolean,
429		  do, implements, protected, throws, break,
430		  double, import, public, transient, byte,
431		  else, instanceof, return, 'try', 'case', extends,
432		  int, short, void, 'catch', final, interface, static,
433		  volatile, char, finally, long, super, while, class,
434		  float, native, switch, const, for, new, synchronized,
435		  continue, goto, package, this, true, false]).
436
437
438
439
440%%-----------------------------------------------------------------
441%% Internal functions
442%%-----------------------------------------------------------------
443