aboutsummaryrefslogblamecommitdiffstats
path: root/lib/ic/src/ictype.erl
blob: eb6f2088d75aabe64426e8c3d2b4c5714a059f65 (plain) (tree)
1
2
3
4
5
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417


                   
                                                        
   










                                                                           









































































































































































































































































































































































































                                                                                         











                                                                                   



















                                                               
































































































































































































































































































































































                                                                                       








                                                                             




































































































































































































































































































































































































































































































































































































































                                                                                    
%%
%% %CopyrightBegin%
%% 
%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
%% 
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%% 
%% %CopyrightEnd%
%%
%%
-module(ictype).


-include("ic.hrl").
-include("icforms.hrl").

%%-----------------------------------------------------------------
%% External exports
%%-----------------------------------------------------------------
-export([type_check/2, scoped_lookup/4, maybe_array/5, to_uppercase/1]).

-export([name2type/2, member2type/3, isBasicTypeOrEterm/3, isEterm/3]).
-export([isBasicType/1, isBasicType/2, isBasicType/3, isString/3, isWString/3, 
	 isArray/3, isStruct/3, isUnion/3, isEnum/3, isSequence/3, isBoolean/3 ]).
-export([fetchTk/3, fetchType/1, tk/4]).
%%-----------------------------------------------------------------
%% Internal exports
%%-----------------------------------------------------------------
-export([]).

%%-----------------------------------------------------------------
%% Macros
%%-----------------------------------------------------------------
%%-define(DBG(F,A), io:format(F,A)).
-define(DBG(F,A), true).
-define(STDDBG, ?DBG("    dbg: ~p: ~p~n", [element(1,X), ic_forms:get_id2(X)])).

%%-----------------------------------------------------------------
%% External functions
%%-----------------------------------------------------------------

type_check(G, Forms) ->
    S = ic_genobj:tktab(G),
    check_list(G, S, [], Forms).

scoped_lookup(G, S, N, X) ->
    Id = ic_symtab:scoped_id_strip(X),
    case ic_symtab:scoped_id_is_global(X) of
	true ->
	    lookup(G, S, [], X, Id);
	false ->
	    lookup(G, S, N, X, Id)
    end.


%%--------------------------------------------------------------------
%% maybe_array
%%
%%	Array declarators are indicated on the declarator and not on
%%	the type, therefore the declarator decides if the array type
%%	kind is added or not.
%%
maybe_array(G, S, N, X, TK) when is_record(X, array) ->
    mk_array(G, S, N, X#array.size, TK);
maybe_array(_G, _S, _N, _, TK) -> TK.



name2type(G, Name) ->
    S = ic_genobj:tktab(G),
    ScopedName = lists:reverse(string:tokens(Name, "_")),
    InfoList = ets:lookup(S, ScopedName ),
    filter( InfoList ).


%% This is en overloaded function,
%% differs in input on unions
member2type(_G, X, I) when is_record(X, union)->
    Name = ic_forms:get_id2(I),
    case lists:keysearch(Name,2,element(6,X#union.tk)) of
	false ->
	    error;
	{value,Rec} ->
	    fetchType(element(3,Rec))
    end;
member2type( G, SName, MName ) ->

    S = ic_genobj:tktab( G ),
    SNList = lists:reverse(string:tokens(SName,"_")),
    ScopedName = [MName | SNList],
    InfoList = ets:lookup( S, ScopedName ),

    case filter( InfoList ) of
	error ->
	    %% Try a little harder, seeking inside tktab
	    case lookup_member_type_in_tktab(S, ScopedName, MName) of
		error ->
		    %% Check if this is the "return to return1" case
		    case MName of
			"return1" ->
			    %% Do it all over again !
			    ScopedName2 = ["return" | SNList],
			    InfoList2 = ets:lookup( S, ScopedName2 ),
			    case filter( InfoList2 ) of
				error ->
				    %% Last resort: seek in pragma table
				    lookup_type_in_pragmatab(G, SName);

				Other ->
				    Other
			    end;		
			_ ->
			    %% Last resort: seek in pragma table
			    lookup_type_in_pragmatab(G, SName)
		    end;
		Other ->
		    Other
	    end;
	Other ->
	    Other
    end.


lookup_member_type_in_tktab(S, ScopedName, MName) ->
    case ets:match_object(S, {'_',member,{MName,'_'},nil}) of
	[] ->
	    error;
	[{_FullScopedName,member,{MName,TKInfo},nil}]->
	    fetchType( TKInfo );
	List ->
	    lookup_member_type_in_tktab(List,ScopedName)
    end.

lookup_member_type_in_tktab([], _ScopedName) ->
    error;
lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) ->
    case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of
	ScopedName ->
	    fetchType(TKInfo);
	_ ->
	    lookup_member_type_in_tktab(Rest,ScopedName)
    end.


lookup_type_in_pragmatab(G, SName) ->    
    S = ic_genobj:pragmatab(G),

    %% Look locally first
    case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of 
	[] ->
	    %% No match, seek included
	    case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of 

		[] ->
		    error;
		[[Type]] ->
		    io:format("1 Found(~p) : ~p~n",[SName,Type]),
		    Type
	    end;

	[[Type]] ->
	    io:format("2 Found(~p) : ~p~n",[SName,Type]),
	    Type
    end.




isString(G, N, T) when element(1, T) == scoped_id ->
    case ic_symtab:get_full_scoped_name(G, N, T) of
	{_FullScopedName, _, {'tk_string',_}, _} ->
	    true;
	_ ->
	    false
    end; 
isString(_G, _N, T)  when is_record(T, string) ->
    true;
isString(_G, _N, _Other) ->
    false. 


isWString(G, N, T) when element(1, T) == scoped_id ->  %% WSTRING
    case ic_symtab:get_full_scoped_name(G, N, T) of
	{_FullScopedName, _, {'tk_wstring',_}, _} ->
	    true;
	_ ->
	    false
    end; 
isWString(_G, _N, T)  when is_record(T, wstring) ->
    true;
isWString(_G, _N, _Other) ->
    false. 


isArray(G, N, T) when element(1, T) == scoped_id ->
    case ic_symtab:get_full_scoped_name(G, N, T) of
	{_FullScopedName, _, {'tk_array', _, _}, _} ->
	    true;
	_ ->
	    false
    end; 
isArray(_G, _N, T)  when is_record(T, array) ->
    true;
isArray(_G, _N, _Other) ->
    false. 


isSequence(G, N, T) when element(1, T) == scoped_id ->
    case ic_symtab:get_full_scoped_name(G, N, T) of
	{_FullScopedName, _, {'tk_sequence', _, _}, _} ->
	    true;
	_ ->
	    false
    end; 
isSequence(_G, _N, T)  when is_record(T, sequence) ->
    true;
isSequence(_G, _N, _Other) ->
    false. 


isStruct(G, N, T) when element(1, T) == scoped_id ->
    case ic_symtab:get_full_scoped_name(G, N, T) of
	{_FullScopedName, _, {'tk_struct', _, _, _}, _} ->
	    true;
	_ ->
	    false
    end; 
isStruct(_G, _N, T)  when is_record(T, struct) ->
    true;
isStruct(_G, _N, _Other) ->
    false.


isUnion(G, N, T) when element(1, T) == scoped_id ->
    case ic_symtab:get_full_scoped_name(G, N, T) of
        {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} ->
            true;
        _Other ->
            false
    end; 
isUnion(_G, _N, T)  when is_record(T, union) ->
    true;
isUnion(_G, _N, _Other) ->
    false.



isEnum(G, N, T) when element(1, T) == scoped_id ->
    case ic_symtab:get_full_scoped_name(G, N, T) of
        {_FullScopedName, _, {'tk_enum',_,_,_}, _} ->
            true;
        _Other ->
            false
    end; 
isEnum(_G, _N, T)  when is_record(T, enum) ->
    true;
isEnum(_G, _N, _Other) ->
    false.



isBoolean(G, N, T) when element(1, T) == scoped_id ->
    {_, _, TK, _} =
	ic_symtab:get_full_scoped_name(G, N, T),
    case fetchType(TK) of
	'boolean' ->
	    true;
	_ ->
	    false
    end;
isBoolean(_, _, {'tk_boolean',_}) ->
    true;
isBoolean(_, _, {'boolean',_}) ->
    true;
isBoolean(_, _, _) ->
    false.


%%%  Just used for C

isBasicTypeOrEterm(G, N, S) ->
    case isBasicType(G, N, S) of
	true ->
	    true;
	false ->
	    isEterm(G, N, S)
    end.

isEterm(G, N, S) when element(1, S) == scoped_id -> 
    {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
    case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of
	"erlang_term" ->
	    true;
	"ETERM*" ->
	    true;
	_X ->
	    false
    end;
isEterm(_G, _Ni, _X) -> 
    false.

isBasicType(_G, _N,  {scoped_id,_,_,["term","erlang"]}) ->
    false;
isBasicType(G, N, S) when element(1, S) == scoped_id ->
    {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
    isBasicType(fetchType(TK));
isBasicType(_G, _N, {string, _} ) -> 
    false;
isBasicType(_G, _N, {wstring, _} ) ->  %% WSTRING 
    false;
isBasicType(_G, _N, {unsigned, {long, _}} ) -> 
    true;
isBasicType(_G, _N, {unsigned, {short, _}} ) -> 
    true;
isBasicType(_G, _N, {Type, _} ) ->
    isBasicType(Type);
isBasicType(_G, _N, _X) ->
    false.


isBasicType( G, Name ) ->
    isBasicType( name2type( G, Name ) ).


isBasicType( Type ) ->
    lists:member(Type,
		 [tk_short,short,
		  tk_long,long,
		  tk_longlong,longlong,  %% LLONG
		  tk_ushort,ushort,
		  tk_ulong,ulong,
		  tk_ulonglong,ulonglong,  %% ULLONG
		  tk_float,float,
		  tk_double,double,
		  tk_boolean,boolean,
		  tk_char,char,
		  tk_wchar,wchar,  %% WCHAR
		  tk_octet,octet,
		  tk_any,any]).    %% Fix for any



%%-----------------------------------------------------------------
%% Internal functions
%%-----------------------------------------------------------------
check(G, _S, N, X) when is_record(X, preproc) ->
    handle_preproc(G, N, X#preproc.cat, X),
    X;

check(G, S, N, X) when is_record(X, op) ->
    ?STDDBG,
    TK = tk_base(G, S, N, ic_forms:get_type(X)),
    tktab_add(G, S, N, X),
    N2 = [ic_forms:get_id2(X) | N],
    Ps = lists:map(fun(P) -> 
			   tktab_add(G, S, N2, P),
			   P#param{tk=tk_base(G, S, N, ic_forms:get_type(P))} end,
		   X#op.params),
    %% Check for exception defs.
    Raises = lists:map(fun(E) -> name_lookup(G, S, N, E) end,
		       X#op.raises),
    case ic_forms:is_oneway(X) of
	true ->
	    if  TK /= tk_void ->
		    ic_error:error(G, {bad_oneway_type, X, TK});
		true -> ok
	    end,
	    case ic:filter_params([inout, out], X#op.params) of
		[] -> ok;			% No out parameters!
		_ ->
		    ic_error:error(G, {oneway_outparams, X})
	    end,
	    case X#op.raises of
		[] -> ok;
		_ ->
		    ic_error:error(G, {oneway_raises, X})
	    end;
	false -> 
	    ok
    end,
    X#op{params=Ps, tk=TK, raises=Raises};

check(G, S, N, X) when is_record(X, interface) ->
    ?STDDBG,
    N2 = [ic_forms:get_id2(X) | N],
    TK = {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)},
    Inherit = inherit_resolve(G, S, N, X#interface.inherit, []),
    tktab_add(G, S, N, X, TK, Inherit),
    CheckedBody = check_list(G, S, N2, ic_forms:get_body(X)),
    InhBody = calc_inherit_body(G, N2, CheckedBody, Inherit, []),
    X2 = X#interface{inherit=Inherit, tk=TK, body=CheckedBody,
		     inherit_body=InhBody},
    ic_symtab:store(G, N, X2),
    X2;

check(G, S, N, X) when is_record(X, forward) ->
    ?STDDBG,
    tktab_add(G, S, N, X, {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}),
    X;

check(G, S, N, #constr_forward{tk = tk_struct} = X) ->
    ?STDDBG,
    ID = ic_forms:get_id2(X),
    Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")),
    tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ID, Module}),
    X;
check(G, S, N, #constr_forward{tk = tk_union} = X) ->
    ?STDDBG,
    ID = ic_forms:get_id2(X),
    Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")),
    tktab_add(G, S, N, X, {tk_union, ictk:get_IR_ID(G, N, X), ID, [], [], Module}),
    X;

check(G, S, N, X) when is_record(X, const) ->
    ?STDDBG,
    case tk_base(G, S, N, ic_forms:get_type(X)) of
	Err when element(1, Err) == error -> X;
	TK ->
	    check_const_tk(G, S, N, X, TK),
	    case iceval:eval_const(G, S, N, TK, X#const.val) of
		Err when element(1, Err) == error -> X;
		{ok, NewTK, Val} ->
		    V = iceval:get_val(Val),
		    tktab_add(G, S, N, X, NewTK, V),
		    X#const{val=V, tk=NewTK};
		Val ->
		    V = iceval:get_val(Val),
		    tktab_add(G, S, N, X, TK, V),
		    X#const{val=V, tk=TK}
	    end
    end;

check(G, S, N, X) when is_record(X, except) ->
    ?STDDBG,
    TK = tk(G, S, N, X),
    X#except{tk=TK};

check(G, S, N, X) when is_record(X, struct) ->
    ?STDDBG,
    TK = tk(G, S, N, X),
    X#struct{tk=TK};

check(G, S, N, X) when is_record(X, enum) ->
    ?STDDBG,
    TK = tk(G, S, N, X),
    X#enum{tk=TK};

check(G, S, N, X) when is_record(X, union) ->
    ?STDDBG,
    TK = tk(G, S, N, X),
    X#union{tk=TK};

check(G, S, N, X) when is_record(X, attr) ->
    ?STDDBG,
    TK = tk_base(G, S, N, ic_forms:get_type(X)),
    XX = #id_of{type=X},
    lists:foreach(fun(Id) -> tktab_add(G, S, N, XX#id_of{id=Id}) end,
		  ic_forms:get_idlist(X)),
    X#attr{tk=TK};

check(G, S, N, X) when is_record(X, module) -> 
    ?STDDBG,
    tktab_add(G, S, N, X),
    X#module{body=check_list(G, S, [ic_forms:get_id2(X) | N], ic_forms:get_body(X))};

check(G, S, N, X) when is_record(X, typedef) ->
    ?STDDBG,
    TKbase = tk(G, S, N, X),
    X#typedef{tk=TKbase};

check(_G, _S, _N, X) ->
    ?DBG("    dbg: ~p~n", [element(1,X)]),
    X.

handle_preproc(G, _N, line_nr, X) -> ic_genobj:set_idlfile(G, ic_forms:get_id2(X));
handle_preproc(_G, _N, _C, _X) -> ok.


%%--------------------------------------------------------------------
%%
%% TK calculation
%%
%%--------------------------------------------------------------------

tk(G, S, N, X) when is_record(X, union) ->
    N2 = [ic_forms:get_id2(X) | N],
    DisrcTK = tk(G, S, N, ic_forms:get_type(X)),
    case check_switch_tk(G, S, N, X, DisrcTK) of
	true ->
	    do_special_enum(G, S, N2, ic_forms:get_type(X)),
	    BodyTK = lists:reverse(
		       tk_caselist(G, S, N2, DisrcTK, ic_forms:get_body(X))),
	    tktab_add(G, S, N, X, 
		      {tk_union, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X),
		       DisrcTK, default_count(ic_forms:get_body(X)), BodyTK});
	false ->
	    tk_void
    end;

tk(G, S, N, X) when is_record(X, enum) ->
    N2 = [ic_forms:get_id2(X) | N],
    tktab_add(G, S, N, X,
	      {tk_enum, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), 
	       enum_body(G, S, N2, ic_forms:get_body(X))});


%% Note that the TK returned from this function is the base TK. It
%% must be modified for each of the identifiers in the idlist (for
%% array reasons).
tk(G, S, N, X) when is_record(X, typedef) ->
    case X of
	%% Special case only for term and java backend !
	{typedef,{any,_},[{'<identifier>',_,"term"}],undefined} ->
	    case ic_options:get_opt(G, be) of
		java ->
		    tktab_add(G, S, N, X, tk_term), 
		    tk_term;
		_ ->
		    TK = tk(G, S, N, ic_forms:get_body(X)),
		    lists:foreach(fun(Id) ->
					  tktab_add(G, S, N, #id_of{id=Id, type=X}, 
						    maybe_array(G, S, N, Id, TK))
				  end,
				  X#typedef.id),
		    TK
	    end;
	_ ->
	    TK = tk(G, S, N, ic_forms:get_body(X)),
	    lists:foreach(fun(Id) ->
				  tktab_add(G, S, N, #id_of{id=Id, type=X}, 
					    maybe_array(G, S, N, Id, TK))
			  end,
			  X#typedef.id),
	    TK
    end;

tk(G, S, N, X) when is_record(X, struct) ->
    N2 = [ic_forms:get_id2(X) | N],
    tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), 
			   tk_memberlist(G, S, N2, ic_forms:get_body(X))});

tk(G, S, N, X) when is_record(X, except) ->
    N2 = [ic_forms:get_id2(X) | N],
    tktab_add(G, S, N, X, {tk_except, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), 
			   tk_memberlist(G, S, N2, ic_forms:get_body(X))});

tk(G, S, N, X) -> tk_base(G, S, N, X).


tk_base(G, S, N, X) when is_record(X, sequence) ->
    {tk_sequence, tk(G, S, N, X#sequence.type), 
     len_eval(G, S, N, X#sequence.length)};

tk_base(G, S, N, X) when is_record(X, string) ->
    {tk_string, len_eval(G, S, N, X#string.length)};

tk_base(G, S, N, X) when is_record(X, wstring) ->  %% WSTRING
    {tk_wstring, len_eval(G, S, N, X#wstring.length)};

%% Fixed constants can be declared as:
%% (1)  const fixed pi = 3.14D; or
%% (2)  typedef fixed<3,2> f32;
%%      const f32 pi = 3.14D;
tk_base(G, S, N, X) when is_record(X, fixed) -> 
    %% Case 2
    {tk_fixed, len_eval(G, S, N, X#fixed.digits), len_eval(G, S, N, X#fixed.scale)};
tk_base(_G, _S, _N, {fixed, _}) -> 
    %% Case 1
    tk_fixed;


%% Special case, here CORBA::TypeCode is built in 
%% ONLY when erl_corba is the backend of choice 
tk_base(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) ->
    case ic_options:get_opt(G, be) of
	false ->
	    tk_TypeCode;
	erl_corba ->
	    tk_TypeCode;
	erl_template ->
	    tk_TypeCode;
	_ ->
	    case scoped_lookup(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) of
		T when element(1, T) == error -> T;
		T when is_tuple(T) -> element(3, T)
	    end 
    end;

tk_base(G, S, N, X) when element(1, X) == scoped_id ->
    case scoped_lookup(G, S, N, X) of
	T when element(1, T) == error -> T;
	T when is_tuple(T) -> element(3, T)
    end;
tk_base(_G, _S, _N, {long, _})			-> tk_long;
tk_base(_G, _S, _N, {'long long', _})		-> tk_longlong;  %% LLONG
tk_base(_G, _S, _N, {short, _})			-> tk_short;
tk_base(_G, _S, _N, {'unsigned', {short, _}})	-> tk_ushort;
tk_base(_G, _S, _N, {'unsigned', {long, _}})	-> tk_ulong;
tk_base(_G, _S, _N, {'unsigned', {'long long', _}})-> tk_ulonglong;  %% ULLONG
tk_base(_G, _S, _N, {float, _})			-> tk_float;
tk_base(_G, _S, _N, {double, _})		-> tk_double;
tk_base(_G, _S, _N, {boolean, _})		-> tk_boolean;
tk_base(_G, _S, _N, {char, _})			-> tk_char;
tk_base(_G, _S, _N, {wchar, _})			-> tk_wchar;  %% WCHAR
tk_base(_G, _S, _N, {octet, _})			-> tk_octet;
tk_base(_G, _S, _N, {null, _})			-> tk_null;
tk_base(_G, _S, _N, {void, _})			-> tk_void;
tk_base(_G, _S, _N, {any, _})			-> tk_any;
tk_base(_G, _S, _N, {'Object', _})		-> {tk_objref, "", "Object"}.


%%--------------------------------------------------------------------
%%
%% Special handling of idlists. Note that the recursion case is given
%% as accumulator to foldr. Idlists are those lists of identifiers
%% that share the same definition, i.e. multiple cases, multiple type
%% declarations, multiple member names.
%%
tk_memberlist(G, S, N, [X | Xs]) ->
    BaseTK = tk(G, S, N, ic_forms:get_type(X)),

    XX = #id_of{type=X},
    lists:foldr(fun(Id, Acc) ->
			[tk_member(G, S, N, XX#id_of{id=Id}, BaseTK) | Acc] end, 
		tk_memberlist(G, S, N, Xs), 
		ic_forms:get_idlist(X));
tk_memberlist(_G, _S, _N, []) -> [].

%% same as above but for case dcls
tk_caselist(G, S, N, DiscrTK, Xs) ->
    lists:foldl(fun(Case, Acc) ->
			BaseTK = tk(G, S, N, ic_forms:get_type(Case)),
			%% tktab_add for the uniqueness check of the declarator
			tktab_add(G, S, N, Case),
			lists:foldl(fun(Id, Acc2) ->
					    case tk_case(G, S, N, Case, BaseTK,
							 DiscrTK, Id) of
						Err when element(1, Err)==error ->
						    Acc2;
						TK ->
						    unique_add_case_label(G, S, N, Id, 
									  TK, Acc2)
					    end
				    end, 
				    Acc,
				    ic_forms:get_idlist(Case))
		end,
		[],
		Xs).


%% Handling of the things that can be in an idlist or caselist
tk_member(G, S, N, X, BaseTK) ->
    tktab_add(G, S, N, X, 
	      {ic_forms:get_id2(X), maybe_array(G, S, N, X#id_of.id, BaseTK)}).


get_case_id_and_check(G, _S, _N, _X, ScopedId) ->
    case ic_symtab:scoped_id_is_global(ScopedId) of
	true -> ic_error:error(G, {bad_scope_enum_case, ScopedId});
	false -> ok
    end,
    case ic_symtab:scoped_id_strip(ScopedId) of
	[Id] -> Id;
	_List -> 
	    ic_error:error(G, {bad_scope_enum_case, ScopedId}), 
	    ""
    end.


tk_case(G, S, N, X, BaseTK, DiscrTK, Id) ->
    case case_eval(G, S, N, DiscrTK, Id) of
	Err when element(1, Err) == error -> Err;
	Val -> 
	    case iceval:check_tk(G, DiscrTK, Val) of
		true -> 
		    {iceval:get_val(Val), ic_forms:get_id2(X),
		     maybe_array(G, S, N, X#case_dcl.id, BaseTK)};
		false ->
		    ic_error:error(G, {bad_case_type, DiscrTK, X, 
				       iceval:get_val(Val)})
	    end
    end.

tktab_add(G, S, N, X) ->
    tktab_add_id(G, S, N, X, ic_forms:get_id2(X), nil, nil).
tktab_add(G, S, N, X, TK) ->
    tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, nil).
tktab_add(G, S, N, X, TK, Aux) ->
    tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, Aux).


tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,enumerator) ->

    %% Check if the "scl" flag is set to true
    %% if so, allow old semantics ( errornous )
    %% Warning, this is for compatibility reasons only.
    Name = case ic_options:get_opt(G, scl) of 
	       true -> 
		   [Id | N];
	       false ->
		   [Id | tl(N)]
	   end,

    UName = mk_uppercase(Name),
    case ets:lookup(S, Name) of
	[_] -> ic_error:error(G, {multiply_defined, X});
	[] ->
	    case ets:lookup(S, UName) of
		[] -> ok;
		[_] -> ic_error:error(G, {illegal_spelling, X})
	    end
    end,
    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
	true -> true end,
    TK;
%%
%% Fixes the multiple file module definition check 
%% but ONLY for Corba backend
%%				
tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,module) ->
    case ic_options:get_opt(G, be) of
	erl_template ->
	    Name = [Id | N],
	    UName = mk_uppercase(Name),
	    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
	    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
		true -> true end,
	    TK;
	erl_corba ->
	    Name = [Id | N],
	    UName = mk_uppercase(Name),
	    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
	    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
		true -> true end,
	    TK;
	false -> %% default == erl_corba
	    Name = [Id | N],
	    UName = mk_uppercase(Name),
	    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
	    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
		true -> true end,
	    TK;
	java -> 
	    Name = [Id | N],
	    UName = mk_uppercase(Name),
	    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
	    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
		true -> true end,
	    TK;
	erl_genserv -> 
	    Name = [Id | N],
	    UName = mk_uppercase(Name),
	    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
	    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
		true -> true end,
	    TK;
	erl_plain -> 
	    Name = [Id | N],
	    UName = mk_uppercase(Name),
	    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
	    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
		true -> true end,
	    TK;
	_Be -> 
	    Name = [Id | N],
	    UName = mk_uppercase(Name),
	    case ets:lookup(S, Name) of
		[_] -> ic_error:error(G, {multiply_defined, X});
		[] ->
		    case ets:lookup(S, UName) of
			[] -> ok;
			[_] -> ic_error:error(G, {illegal_spelling, X})
		    end
	    end,
	    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
	    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
		true -> true end,
	    TK
    end;
tktab_add_id(G, S, N, X, Id, TK, Aux) ->
    Name = [Id | N],
    UName = mk_uppercase(Name),
    case ets:lookup(S, Name) of
	[{_, forward, _, _}] when is_record(X, interface) ->
	    ok;
	[{_, constr_forward, _, _}] when is_record(X, union) orelse 
					 is_record(X, struct) -> 
	    ok;
	[XX] when is_record(X, forward) andalso element(2, XX)==interface -> 
	    ok;
	[_] -> 
	    ic_error:error(G, {multiply_defined, X});
	[] ->
	    case ets:lookup(S, UName) of
		[] -> ok;
		[_] -> ic_error:error(G, {illegal_spelling, X})
	    end
    end,
    ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
    if  UName =/= Name -> ets:insert(S, {UName, spellcheck});
	true -> true end,
    TK.




%%--------------------------------------------------------------------
%% enum_body
%%
%%	Special because ids are treated different than usual.
%%
enum_body(G, S, N, [Enum | EnumList]) -> 
    tktab_add(G, S, N, Enum), %%%, enum_val, Enum),
    %%    tktab_add(G, S, N, X, TK, V),
    [ic_forms:get_id2(Enum) | enum_body(G, S, N, EnumList)];
enum_body(_G, _S, _N, []) -> [].


%%--------------------------------------------------------------------
%% mk_array
%%
%%	Multi dimensional arrays are written as nested tk_array
%%
mk_array(G, S, N, [Sz | Szs], TK) ->
    case iceval:eval_const(G, S, N, positive_int, Sz) of
	Err when element(1, Err) == error -> TK;
	Val ->
	    {tk_array, mk_array(G, S, N, Szs, TK), iceval:get_val(Val)}
    end;
mk_array(_G, _S, _N, [], TK) -> TK.


%%--------------------------------------------------------------------
%% len_eval
%%
%%	Evaluates the length, which in case it has been left out is a
%%	plain 0 (zero)
%%
len_eval(_G, _S, _N, 0) -> 0;
len_eval(G, S, N, X) -> %%iceval:eval_const(G, S, N, positive_int, X).
    case iceval:eval_const(G, S, N, positive_int, X) of
	Err when element(1, Err) == error -> 0;
	Val -> iceval:get_val(Val)
    end.


%%--------------------------------------------------------------------
%% case_eval
%%
%%	Evaluates the case label.
%%

case_eval(G, S, N, DiscrTK, X) when element(1, DiscrTK) == tk_enum,
				    element(1, X) == scoped_id -> 
    {tk_enum, _, _, Cases} = DiscrTK,
    Id = get_case_id_and_check(G, S, N, X, X),
    %%io:format("Matching: ~p to ~p~n", [Id, Cases]),
    case lists:member(Id, Cases) of
	true ->
	    {enum_id, Id};
	false ->
	    iceval:mk_val(scoped_lookup(G, S, N, X)) % Will generate error
    end;

case_eval(G, S, N, DiscrTK, X) -> 
    iceval:eval_e(G, S, N, DiscrTK, X).


%% The enum declarator is in the union scope.
do_special_enum(G, S, N, X) when is_record(X, enum) ->
    tktab_add(G, S, N, #id_of{id=X#enum.id, type=X});
do_special_enum(_G, _S, _N, _X) ->
    ok.


unique_add_case_label(G, _S, _N, Id, TK, TKList) ->
%%%io:format("check_case_labels: TK:~p TKLIST:~p ~n", [TK, TKList]),
    if  element(1, TK) == error -> 
	    TKList;
	true ->
	    case lists:keysearch(element(1, TK), 1, TKList) of
		{value, _} -> 
		    ic_error:error(G, {multiple_cases, Id}),
		    TKList;
		false -> 
		    [TK | TKList]
	    end
    end.


%%--------------------------------------------------------------------
%% default_count
%%
%%	Returns the position of the default case.
%%
%%	Modified for OTP-2007
%%
default_count(Xs) ->
    default_count2(Xs, 0).

default_count2([X | Xs], N) -> default_count3(X#case_dcl.label, Xs, N);
default_count2([], _) -> -1.

default_count3([{default, _} | _Ys], _Xs, N) -> N;
default_count3([_ | Ys], Xs, N) -> default_count3(Ys, Xs, N+1);
default_count3([], Xs, N) -> default_count2(Xs, N).




%%
%% Type checks.
%%
%% Check constant type references (only for the scoped id case, others
%% are caught by the BNF)
%%
check_const_tk(_G, _S, _N, _X, tk_long) -> true;
check_const_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG
check_const_tk(_G, _S, _N, _X, tk_short) -> true;
check_const_tk(_G, _S, _N, _X, tk_ushort) -> true;
check_const_tk(_G, _S, _N, _X, tk_ulong) -> true; 
check_const_tk(_G, _S, _N, _X, tk_ulonglong) -> true;  %% ULLONG
check_const_tk(_G, _S, _N, _X, tk_float) -> true;
check_const_tk(_G, _S, _N, _X, tk_double) -> true;
check_const_tk(_G, _S, _N, _X, tk_boolean) -> true;
check_const_tk(_G, _S, _N, _X, tk_char) -> true;
check_const_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR
check_const_tk(_G, _S, _N, _X, tk_octet) -> true;
check_const_tk(_G, _S, _N, _X, {tk_string, _Len}) -> true;
check_const_tk(_G, _S, _N, _X, {tk_wstring, _Len}) -> true; %% WSTRING
check_const_tk(_G, _S, _N, _X, tk_fixed) -> true;
check_const_tk(_G, _S, _N, _X, {tk_fixed, _Digits, _Scale}) -> true;
check_const_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_const_t, X, TK}).


check_switch_tk(_G, _S, _N, _X, tk_long) -> true;
check_switch_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG
check_switch_tk(_G, _S, _N, _X, tk_short) -> true;
check_switch_tk(_G, _S, _N, _X, tk_ushort) -> true;
check_switch_tk(_G, _S, _N, _X, tk_ulong) -> true;
check_switch_tk(_G, _S, _N, _X, tk_ulonglong) -> true;  %% ULLONG
check_switch_tk(_G, _S, _N, _X, tk_boolean) -> true;
check_switch_tk(_G, _S, _N, _X, tk_char) -> true;
check_switch_tk(_G, _S, _N, _X, tk_wchar) -> true;  %% WCHAR
check_switch_tk(_G, _S, _N, _X, TK) when element(1, TK) == tk_enum -> true;
check_switch_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_switch_t, X, TK}),
				     false.



%% Lookup a name
name_lookup(G, S, N, X) ->
    case scoped_lookup(G, S, N, X) of
	T when is_tuple(T) -> element(1, T)
    end.


lookup(G, S, N, X, Id) ->
    N2 = Id ++ N,
    ?DBG("  Trying ~p ...~n", [N2]),
    case ets:lookup(S, N2) of
	[] ->	    
	    case look_for_interface(G, S, [hd(N2)], tl(N2)) of

		%% First attempt: filtering inherited members !
		[{_, member, _, _}] ->	    
		    case look_for_interface(G, S, [hd(N)], tl(N2)) of
			[T] -> 
			    ?DBG("    --  found ~p~n", [T]), 
			    T;
			_ ->
			    lookup(G, S, tl(N), X, Id)
		    end;
		%%

		[T] -> 
		    ?DBG("    --  found ~p~n", [T]), 
		    T;

		_ ->
		    if  N == [] -> 
			    ic_error:error(G, {tk_not_found, X});
			true ->
			    lookup(G, S, tl(N), X, Id)
		    end

	    end;

	%% Second attempt: filtering members !
	[{_, member, _, _}] ->	    
	    case look_for_interface(G, S, [hd(N2)], tl(N2)) of
		[T] -> 
		    ?DBG("    --  found ~p~n", [T]), 
		    T;
		_ ->
		    if  N == [] -> 
			    ic_error:error(G, {tk_not_found, X});
			true ->
			    lookup(G, S, tl(N), X, Id)
		    end
	    end;
	%%
	[T] -> 
	    ?DBG("    --  found ~p~n", [T]),
	    T
    end.


look_for_interface(_G, _S, _Hd, []) -> 
    false;
look_for_interface(G, S, Hd, Tl) ->
    case ets:lookup(S, Tl) of
	[{_, interface, _TK, Inh}] -> 
	    case look_in_inherit(G, S, Hd, Inh) of
		%% gather_inherit(G, S, Inh, [])) of
		[X] when is_tuple(X) -> 
		    [X];
		_ -> 
		    look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl))
	    end;
	_ -> 
	    look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl))
    end.

look_in_inherit(G, S, Id, [I | Is]) ->
    case ets:lookup(S, Id ++ I) of
	[X] when is_tuple(X) -> 
	    [X];
	[] ->  
	    look_in_inherit(G, S, Id, Is)
    end;
look_in_inherit(_G, _S, _Id, []) -> 
    false.


%% L is a list of names
mk_uppercase(L) ->
    lists:map(fun(Z) -> lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A;
				     (X) -> X end, Z) end, L).


%%--------------------------------------------------------------------
%%
%% Inheritance stuff
%%
%%
%%--------------------------------------------------------------------

%% InhBody is an accumulating parameter

calc_inherit_body(G, N, OrigBody, [X|Xs], InhBody) ->
    case ic_symtab:retrieve(G, X) of
	Intf when is_record(Intf, interface) ->
	    Body = filter_body(G, X, ic_forms:get_body(Intf), N, OrigBody, InhBody),
	    calc_inherit_body(G, N, OrigBody, Xs, [{X, Body} | InhBody]);
	XXX ->
	    io:format("Oops, not found ~p~n", [XXX]),
	    calc_inherit_body(G, N, OrigBody, Xs, InhBody)
    end;
calc_inherit_body(_G, _N, _OrigBody, [], InhBody) -> lists:reverse(InhBody).


filter_body(G, XPath, [X | Xs], OrigPath, OrigBody, InhBody) ->
    case complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) of
	true -> 
	    %%io:format("NOT adding ~p~n", [ic_forms:get_id2(X)]),
	    filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody);
	{false, NewX} ->			% For those with idlist
	    %%io:format("Adding from idlist~n", []),
	    [NewX | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)];
	false ->
	    %%io:format("Adding: ~p~n", [ic_forms:get_id2(X)]),
	    [X | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)]
    end;
filter_body(_G, _XPath, [], _OrigPath, _OrigBody, _InhBody) -> [].


complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) ->
    case has_idlist(X) of
	true ->
	    idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody);
	false ->
	    straight_member(G, XPath, X, OrigPath, OrigBody, InhBody)
    end.


idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody) ->    
    XX = #id_of{type=X},
    F = fun(Id) ->
		not(straight_member(G, XPath, XX#id_of{id=Id}, OrigPath,
				    OrigBody, InhBody))
	end,
    case lists:filter(F, ic_forms:get_idlist(X)) of
	[] -> 
	    true;
	IdList ->
%%%	    io:format("Idlist added: ~p~n",[IdList]),
	    {false, replace_idlist(X, IdList)}
    end.


straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) ->
    %%io:format("straight member: ~p~n", [ic_forms:get_id2(X)]),
    case body_member(G, XPath, X, OrigPath, OrigBody) of
	true ->
	    true;
	false -> 
	    inh_body_member(G, XPath, X, InhBody)
    end.


inh_body_member(G, XPath, X, [{Name, Body} | InhBody]) ->
    case body_member(G, XPath, X, Name, Body) of
	true ->
	    true;
	false -> 
	    inh_body_member(G, XPath, X, InhBody)
    end;
inh_body_member(_G, _XPath, _X, []) -> false.


body_member(G, XPath, X, YPath, [Y|Ys]) ->
    case has_idlist(Y) of
	true -> 
	    YY = #id_of{type=Y},
	    case list_and(fun(Y2) -> 
				  not(is_equal(G, XPath, X, YPath, 
					       YY#id_of{id=Y2})) end,
			  ic_forms:get_idlist(Y)) of
		true -> 
		    body_member(G, XPath, X, YPath, Ys);
		false ->
		    true
	    end;
	false ->
	    case is_equal(G, XPath, X, YPath, Y) of
		false ->
		    body_member(G, XPath, X, YPath, Ys);
		true ->
		    true
	    end
    end;
body_member(_G, _XPath, _X, _YPath, []) -> false.


is_equal(G, XPath, X, YPath, Y) ->
    case {ic_forms:get_id2(X), ic_forms:get_id2(Y)} of
	{ID, ID} ->
	    collision(G, XPath, X, YPath, Y),
	    true;
	_ -> 
	    false
    end.


%% X is the new item, Y is the old one. So it is X that collides with
%% Y and Y shadows X.
collision(G, XPath, X, YPath, Y) ->
    I1 = get_beef(X),
						%    I2 = get_beef(Y),
    if is_record(I1, op) -> %%, record(I2, op) ->
	    ic_error:error(G, {inherit_name_collision, 
			       {YPath, Y}, {XPath, X}});
       is_record(I1, attr) -> %%, record(I2, attr) ->
	    ic_error:error(G, {inherit_name_collision, 
			       {YPath, Y}, {XPath, X}});
       true ->
	    ?ifopt(G, warn_name_shadow, 
		   ic_error:warn(G, {inherit_name_shadow, 
				     {YPath, Y}, {XPath, X}}))
    end.

has_idlist(X) when is_record(X, typedef) -> true;
has_idlist(X) when is_record(X, member) -> true;
has_idlist(X) when is_record(X, case_dcl) -> true;
has_idlist(X) when is_record(X, attr) -> true;
has_idlist(_) -> false.

replace_idlist(X, IdList) when is_record(X, typedef) -> X#typedef{id=IdList};
replace_idlist(X, IdList) when is_record(X, attr) -> X#attr{id=IdList}.

get_beef(X) when is_record(X, id_of) -> X#id_of.type;
get_beef(X) -> X.


%% And among all elements in list
list_and(F, [X|Xs]) ->
    case F(X) of
	true -> list_and(F, Xs);
	false -> false
    end;
list_and(_F, []) -> true.





%%--------------------------------------------------------------------
%%
%%	resolve_inherit shall return a list of resolved inheritances,
%%	that is all names replaced with their global names.
%%

inherit_resolve(G, S, N, [X|Rest], Out) ->
    case scoped_lookup(G, S, N, X) of
	{Name, _T, _TK, Inh} ->
	    case lists:member(Name, Out) of
		true -> 
		    inherit_resolve(G, S, N, Rest, Out);
		false ->
		    case unique_append(Inh, [Name|Out]) of
			error ->
			    ic_error:error(G, {inherit_resolve, X, Name}),
			    inherit_resolve(G, S, N, Rest, []);
			UA ->
			    inherit_resolve(G, S, N, Rest, UA)
		    end
	    end;
	_ -> inherit_resolve(G, S, N, Rest, Out)
    end;
inherit_resolve(_G, _S, _N, [], Out) -> lists:reverse(Out).

unique_append([X|Xs], L) ->
    case lists:member(X, L) of
	true -> unique_append(Xs, L);
	false -> unique_append(Xs, [X|L])
    end;
unique_append([], L) -> L;
%% Error 
unique_append(_, _L) -> error.




%%--------------------------------------------------------------------
%%
%%	Utilities
%%

%% Must preserve order, therefore had to write my own (instead of lists:map)
check_list(G, S, N, [X|Xs]) ->
    X1 = check(G, S, N, X),
    [X1 | check_list(G, S, N, Xs)];
check_list(_G, _S, _N, []) -> [].



filter( [] ) ->
    error;
filter( [I | Is ] ) ->
    case I of
	{ _, member, { _, TKINFO }, _ } ->
	    fetchType( TKINFO );

        { _, struct, _, _ } ->
	    struct;

	{ _, typedef, TKINFO, _ } ->
	    fetchType( TKINFO );

	{ _, module, _, _ } ->
	    module;

	{ _, interface, _, _ } ->
	    interface;

	{ _, op, _, _ } ->
	    op;

	{ _,enum, _, _ } ->
	    enum;

	{ _, spellcheck } ->
	    filter( Is );

	_ ->
	    error
    end.


fetchType( { tk_sequence, _, _ } ) ->
    sequence;
fetchType( { tk_array, _, _ } ) ->
    array;
fetchType( { tk_struct, _, _, _} ) ->
    struct;
fetchType( { tk_string, _} ) ->
    string;
fetchType( { tk_wstring, _} ) ->  %% WSTRING
    wstring;
fetchType( { tk_fixed, _, _} ) ->
    fixed;
fetchType( tk_short ) ->
    short;
fetchType( tk_long ) ->
    long;
fetchType( tk_longlong ) ->  %% LLONG
    longlong;
fetchType( tk_ushort ) ->
    ushort;
fetchType( tk_ulong ) ->
    ulong;
fetchType( tk_ulonglong ) ->  %% ULLONG
    ulonglong;
fetchType( tk_float ) ->
    float;
fetchType( tk_double ) ->
    double;
fetchType( tk_boolean ) ->
    boolean;
fetchType( tk_char ) ->
    char;
fetchType( tk_wchar ) ->  %% WCHAR
    wchar;
fetchType( tk_octet ) ->
    octet;
fetchType( { tk_enum, _, _, _ } ) ->
    enum;
fetchType( { tk_union, _, _, _, _, _ } ) ->
    union;
fetchType( tk_any ) ->
    any;
fetchType( _ ) ->
    error.

%% Z is a single name
to_uppercase(Z) ->
    lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A;
		 (X) -> X end, Z).


%%------------------------------------------------------------
%%
%% Always fetchs TK of a record.
%%
%%------------------------------------------------------------
fetchTk(G,N,X) ->
    case ic_forms:get_tk(X) of
        undefined ->
            searchTk(G,ictk:get_IR_ID(G, N, X));
        TK ->
            TK
    end.


%%------------------------------------------------------------
%%
%% seek type code when not accessible by get_tk/1
%%
%%------------------------------------------------------------
searchTk(G,IR_ID) ->
    S = ic_genobj:tktab(G),
    case catch searchTk(S,IR_ID,typedef) of
        {value,TK} ->
            TK;
        _ -> %% false / exit
            case catch searchTk(S,IR_ID,struct) of
                {value,TK} ->
                    TK;
                _  ->  %% false / exit
                    case catch searchTk(S,IR_ID,union) of
                        {value,TK} ->
                            TK;
                        _ ->
                            undefined
                    end
            end
    end.


searchTk(S,IR_ID,Type) ->
    L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})),
    case lists:keysearch(IR_ID,2,L) of
        {value,TK} ->
            {value,TK};
        false ->
            searchInsideTks(L,IR_ID)
    end.


searchInsideTks([],_IR_ID) ->
    false;
searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) ->
    case searchIncludedTk(TK,IR_ID) of
        {value,TK} ->
            {value,TK};
        false ->
            searchInsideTks(Xs,IR_ID)
    end.


searchIncludedTk({tk_array,TK,_},IR_ID) ->
    searchIncludedTk(TK,IR_ID);
searchIncludedTk({tk_sequence,TK,_},IR_ID) ->
    searchIncludedTk(TK,IR_ID);
searchIncludedTk(TK, _IR_ID) when is_atom(TK) ->
    false;
searchIncludedTk(TK,IR_ID) ->
    case element(2,TK) == IR_ID of
        true ->
            {value,TK};
        false ->
            false
    end.