1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 1997-2020. 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(ictype). 22 23 24-include("ic.hrl"). 25-include("icforms.hrl"). 26 27%%----------------------------------------------------------------- 28%% External exports 29%%----------------------------------------------------------------- 30-export([type_check/2, scoped_lookup/4, maybe_array/5, to_uppercase/1]). 31 32-export([name2type/2, member2type/3, isBasicTypeOrEterm/3, isEterm/3]). 33-export([isBasicType/1, isBasicType/2, isBasicType/3, isString/3, isWString/3, 34 isArray/3, isStruct/3, isUnion/3, isEnum/3, isSequence/3, isBoolean/3 ]). 35-export([fetchTk/3, fetchType/1, tk/4]). 36%%----------------------------------------------------------------- 37%% Internal exports 38%%----------------------------------------------------------------- 39-export([]). 40 41%%----------------------------------------------------------------- 42%% Macros 43%%----------------------------------------------------------------- 44%%-define(DBG(F,A), io:format(F,A)). 45-define(DBG(F,A), true). 46-define(STDDBG, ?DBG(" dbg: ~p: ~p~n", [element(1,X), ic_forms:get_id2(X)])). 47 48%%----------------------------------------------------------------- 49%% External functions 50%%----------------------------------------------------------------- 51 52type_check(G, Forms) -> 53 S = ic_genobj:tktab(G), 54 check_list(G, S, [], Forms). 55 56scoped_lookup(G, S, N, X) -> 57 Id = ic_symtab:scoped_id_strip(X), 58 case ic_symtab:scoped_id_is_global(X) of 59 true -> 60 lookup(G, S, [], X, Id); 61 false -> 62 lookup(G, S, N, X, Id) 63 end. 64 65 66%%-------------------------------------------------------------------- 67%% maybe_array 68%% 69%% Array declarators are indicated on the declarator and not on 70%% the type, therefore the declarator decides if the array type 71%% kind is added or not. 72%% 73maybe_array(G, S, N, X, TK) when is_record(X, array) -> 74 mk_array(G, S, N, X#array.size, TK); 75maybe_array(_G, _S, _N, _, TK) -> TK. 76 77 78 79name2type(G, Name) -> 80 S = ic_genobj:tktab(G), 81 ScopedName = lists:reverse(string:tokens(Name, "_")), 82 InfoList = ets:lookup(S, ScopedName ), 83 filter( InfoList ). 84 85 86%% This is en overloaded function, 87%% differs in input on unions 88member2type(_G, X, I) when is_record(X, union)-> 89 Name = ic_forms:get_id2(I), 90 case lists:keysearch(Name,2,element(6,X#union.tk)) of 91 false -> 92 error; 93 {value,Rec} -> 94 fetchType(element(3,Rec)) 95 end; 96member2type( G, SName, MName ) -> 97 98 S = ic_genobj:tktab( G ), 99 SNList = lists:reverse(string:tokens(SName,"_")), 100 ScopedName = [MName | SNList], 101 InfoList = ets:lookup( S, ScopedName ), 102 103 case filter( InfoList ) of 104 error -> 105 %% Try a little harder, seeking inside tktab 106 case lookup_member_type_in_tktab(S, ScopedName, MName) of 107 error -> 108 %% Check if this is the "return to return1" case 109 case MName of 110 "return1" -> 111 %% Do it all over again ! 112 ScopedName2 = ["return" | SNList], 113 InfoList2 = ets:lookup( S, ScopedName2 ), 114 case filter( InfoList2 ) of 115 error -> 116 %% Last resort: seek in pragma table 117 lookup_type_in_pragmatab(G, SName); 118 119 Other -> 120 Other 121 end; 122 _ -> 123 %% Last resort: seek in pragma table 124 lookup_type_in_pragmatab(G, SName) 125 end; 126 Other -> 127 Other 128 end; 129 Other -> 130 Other 131 end. 132 133 134lookup_member_type_in_tktab(S, ScopedName, MName) -> 135 case ets:match_object(S, {'_',member,{MName,'_'},nil}) of 136 [] -> 137 error; 138 [{_FullScopedName,member,{MName,TKInfo},nil}]-> 139 fetchType( TKInfo ); 140 List -> 141 lookup_member_type_in_tktab(List,ScopedName) 142 end. 143 144lookup_member_type_in_tktab([], _ScopedName) -> 145 error; 146lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) -> 147 case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of 148 ScopedName -> 149 fetchType(TKInfo); 150 _ -> 151 lookup_member_type_in_tktab(Rest,ScopedName) 152 end. 153 154 155lookup_type_in_pragmatab(G, SName) -> 156 S = ic_genobj:pragmatab(G), 157 158 %% Look locally first 159 case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of 160 [] -> 161 %% No match, seek included 162 case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of 163 164 [] -> 165 error; 166 [[Type]] -> 167 io:format("1 Found(~p) : ~p~n",[SName,Type]), 168 Type 169 end; 170 171 [[Type]] -> 172 io:format("2 Found(~p) : ~p~n",[SName,Type]), 173 Type 174 end. 175 176 177 178 179isString(G, N, T) when element(1, T) == scoped_id -> 180 case ic_symtab:get_full_scoped_name(G, N, T) of 181 {_FullScopedName, _, {'tk_string',_}, _} -> 182 true; 183 _ -> 184 false 185 end; 186isString(_G, _N, T) when is_record(T, string) -> 187 true; 188isString(_G, _N, _Other) -> 189 false. 190 191 192isWString(G, N, T) when element(1, T) == scoped_id -> %% WSTRING 193 case ic_symtab:get_full_scoped_name(G, N, T) of 194 {_FullScopedName, _, {'tk_wstring',_}, _} -> 195 true; 196 _ -> 197 false 198 end; 199isWString(_G, _N, T) when is_record(T, wstring) -> 200 true; 201isWString(_G, _N, _Other) -> 202 false. 203 204 205isArray(G, N, T) when element(1, T) == scoped_id -> 206 case ic_symtab:get_full_scoped_name(G, N, T) of 207 {_FullScopedName, _, {'tk_array', _, _}, _} -> 208 true; 209 _ -> 210 false 211 end; 212isArray(_G, _N, T) when is_record(T, array) -> 213 true; 214isArray(_G, _N, _Other) -> 215 false. 216 217 218isSequence(G, N, T) when element(1, T) == scoped_id -> 219 case ic_symtab:get_full_scoped_name(G, N, T) of 220 {_FullScopedName, _, {'tk_sequence', _, _}, _} -> 221 true; 222 _ -> 223 false 224 end; 225isSequence(_G, _N, T) when is_record(T, sequence) -> 226 true; 227isSequence(_G, _N, _Other) -> 228 false. 229 230 231isStruct(G, N, T) when element(1, T) == scoped_id -> 232 case ic_symtab:get_full_scoped_name(G, N, T) of 233 {_FullScopedName, _, {'tk_struct', _, _, _}, _} -> 234 true; 235 _ -> 236 false 237 end; 238isStruct(_G, _N, T) when is_record(T, struct) -> 239 true; 240isStruct(_G, _N, _Other) -> 241 false. 242 243 244isUnion(G, N, T) when element(1, T) == scoped_id -> 245 case ic_symtab:get_full_scoped_name(G, N, T) of 246 {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} -> 247 true; 248 _Other -> 249 false 250 end; 251isUnion(_G, _N, T) when is_record(T, union) -> 252 true; 253isUnion(_G, _N, _Other) -> 254 false. 255 256 257 258isEnum(G, N, T) when element(1, T) == scoped_id -> 259 case ic_symtab:get_full_scoped_name(G, N, T) of 260 {_FullScopedName, _, {'tk_enum',_,_,_}, _} -> 261 true; 262 _Other -> 263 false 264 end; 265isEnum(_G, _N, T) when is_record(T, enum) -> 266 true; 267isEnum(_G, _N, _Other) -> 268 false. 269 270 271 272isBoolean(G, N, T) when element(1, T) == scoped_id -> 273 {_, _, TK, _} = 274 ic_symtab:get_full_scoped_name(G, N, T), 275 case fetchType(TK) of 276 'boolean' -> 277 true; 278 _ -> 279 false 280 end; 281isBoolean(_, _, {'tk_boolean',_}) -> 282 true; 283isBoolean(_, _, {'boolean',_}) -> 284 true; 285isBoolean(_, _, _) -> 286 false. 287 288 289%%% Just used for C 290 291isBasicTypeOrEterm(G, N, S) -> 292 case isBasicType(G, N, S) of 293 true -> 294 true; 295 false -> 296 isEterm(G, N, S) 297 end. 298 299isEterm(G, N, S) when element(1, S) == scoped_id -> 300 {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), 301 case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of 302 "erlang_term" -> 303 true; 304 "ic_erlang_term*" -> 305 true; 306 _X -> 307 false 308 end; 309isEterm(_G, _Ni, _X) -> 310 false. 311 312isBasicType(_G, _N, {scoped_id,_,_,["term","erlang"]}) -> 313 false; 314isBasicType(G, N, S) when element(1, S) == scoped_id -> 315 {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), 316 isBasicType(fetchType(TK)); 317isBasicType(_G, _N, {string, _} ) -> 318 false; 319isBasicType(_G, _N, {wstring, _} ) -> %% WSTRING 320 false; 321isBasicType(_G, _N, {unsigned, {long, _}} ) -> 322 true; 323isBasicType(_G, _N, {unsigned, {short, _}} ) -> 324 true; 325isBasicType(_G, _N, {Type, _} ) -> 326 isBasicType(Type); 327isBasicType(_G, _N, _X) -> 328 false. 329 330 331isBasicType( G, Name ) -> 332 isBasicType( name2type( G, Name ) ). 333 334 335isBasicType( Type ) -> 336 lists:member(Type, 337 [tk_short,short, 338 tk_long,long, 339 tk_longlong,longlong, %% LLONG 340 tk_ushort,ushort, 341 tk_ulong,ulong, 342 tk_ulonglong,ulonglong, %% ULLONG 343 tk_float,float, 344 tk_double,double, 345 tk_boolean,boolean, 346 tk_char,char, 347 tk_wchar,wchar, %% WCHAR 348 tk_octet,octet, 349 tk_any,any]). %% Fix for any 350 351 352 353%%----------------------------------------------------------------- 354%% Internal functions 355%%----------------------------------------------------------------- 356check(G, _S, N, X) when is_record(X, preproc) -> 357 handle_preproc(G, N, X#preproc.cat, X), 358 X; 359 360check(G, S, N, X) when is_record(X, op) -> 361 ?STDDBG, 362 TK = tk_base(G, S, N, ic_forms:get_type(X)), 363 tktab_add(G, S, N, X), 364 N2 = [ic_forms:get_id2(X) | N], 365 Ps = lists:map(fun(P) -> 366 tktab_add(G, S, N2, P), 367 P#param{tk=tk_base(G, S, N, ic_forms:get_type(P))} end, 368 X#op.params), 369 %% Check for exception defs. 370 Raises = lists:map(fun(E) -> name_lookup(G, S, N, E) end, 371 X#op.raises), 372 case ic_forms:is_oneway(X) of 373 true -> 374 if TK /= tk_void -> 375 ic_error:error(G, {bad_oneway_type, X, TK}); 376 true -> ok 377 end, 378 case ic:filter_params([inout, out], X#op.params) of 379 [] -> ok; % No out parameters! 380 _ -> 381 ic_error:error(G, {oneway_outparams, X}) 382 end, 383 case X#op.raises of 384 [] -> ok; 385 _ -> 386 ic_error:error(G, {oneway_raises, X}) 387 end; 388 false -> 389 ok 390 end, 391 X#op{params=Ps, tk=TK, raises=Raises}; 392 393check(G, S, N, X) when is_record(X, interface) -> 394 ?STDDBG, 395 N2 = [ic_forms:get_id2(X) | N], 396 TK = {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}, 397 Inherit = inherit_resolve(G, S, N, X#interface.inherit, []), 398 tktab_add(G, S, N, X, TK, Inherit), 399 CheckedBody = check_list(G, S, N2, ic_forms:get_body(X)), 400 InhBody = calc_inherit_body(G, N2, CheckedBody, Inherit, []), 401 X2 = X#interface{inherit=Inherit, tk=TK, body=CheckedBody, 402 inherit_body=InhBody}, 403 ic_symtab:store(G, N, X2), 404 X2; 405 406check(G, S, N, X) when is_record(X, forward) -> 407 ?STDDBG, 408 tktab_add(G, S, N, X, {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}), 409 X; 410 411check(G, S, N, #constr_forward{tk = tk_struct} = X) -> 412 ?STDDBG, 413 ID = ic_forms:get_id2(X), 414 Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")), 415 tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ID, Module}), 416 X; 417check(G, S, N, #constr_forward{tk = tk_union} = X) -> 418 ?STDDBG, 419 ID = ic_forms:get_id2(X), 420 Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")), 421 tktab_add(G, S, N, X, {tk_union, ictk:get_IR_ID(G, N, X), ID, [], [], Module}), 422 X; 423 424check(G, S, N, X) when is_record(X, const) -> 425 ?STDDBG, 426 case tk_base(G, S, N, ic_forms:get_type(X)) of 427 Err when element(1, Err) == error -> X; 428 TK -> 429 check_const_tk(G, S, N, X, TK), 430 case iceval:eval_const(G, S, N, TK, X#const.val) of 431 Err when element(1, Err) == error -> X; 432 {ok, NewTK, Val} -> 433 V = iceval:get_val(Val), 434 tktab_add(G, S, N, X, NewTK, V), 435 X#const{val=V, tk=NewTK}; 436 Val -> 437 V = iceval:get_val(Val), 438 tktab_add(G, S, N, X, TK, V), 439 X#const{val=V, tk=TK} 440 end 441 end; 442 443check(G, S, N, X) when is_record(X, except) -> 444 ?STDDBG, 445 TK = tk(G, S, N, X), 446 X#except{tk=TK}; 447 448check(G, S, N, X) when is_record(X, struct) -> 449 ?STDDBG, 450 TK = tk(G, S, N, X), 451 X#struct{tk=TK}; 452 453check(G, S, N, X) when is_record(X, enum) -> 454 ?STDDBG, 455 TK = tk(G, S, N, X), 456 X#enum{tk=TK}; 457 458check(G, S, N, X) when is_record(X, union) -> 459 ?STDDBG, 460 TK = tk(G, S, N, X), 461 X#union{tk=TK}; 462 463check(G, S, N, X) when is_record(X, attr) -> 464 ?STDDBG, 465 TK = tk_base(G, S, N, ic_forms:get_type(X)), 466 XX = #id_of{type=X}, 467 lists:foreach(fun(Id) -> tktab_add(G, S, N, XX#id_of{id=Id}) end, 468 ic_forms:get_idlist(X)), 469 X#attr{tk=TK}; 470 471check(G, S, N, X) when is_record(X, module) -> 472 ?STDDBG, 473 tktab_add(G, S, N, X), 474 X#module{body=check_list(G, S, [ic_forms:get_id2(X) | N], ic_forms:get_body(X))}; 475 476check(G, S, N, X) when is_record(X, typedef) -> 477 ?STDDBG, 478 TKbase = tk(G, S, N, X), 479 X#typedef{tk=TKbase}; 480 481check(_G, _S, _N, X) -> 482 ?DBG(" dbg: ~p~n", [element(1,X)]), 483 X. 484 485handle_preproc(G, _N, line_nr, X) -> ic_genobj:set_idlfile(G, ic_forms:get_id2(X)); 486handle_preproc(_G, _N, _C, _X) -> ok. 487 488 489%%-------------------------------------------------------------------- 490%% 491%% TK calculation 492%% 493%%-------------------------------------------------------------------- 494 495tk(G, S, N, X) when is_record(X, union) -> 496 N2 = [ic_forms:get_id2(X) | N], 497 DisrcTK = tk(G, S, N, ic_forms:get_type(X)), 498 case check_switch_tk(G, S, N, X, DisrcTK) of 499 true -> 500 do_special_enum(G, S, N2, ic_forms:get_type(X)), 501 BodyTK = lists:reverse( 502 tk_caselist(G, S, N2, DisrcTK, ic_forms:get_body(X))), 503 tktab_add(G, S, N, X, 504 {tk_union, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), 505 DisrcTK, default_count(ic_forms:get_body(X)), BodyTK}); 506 false -> 507 tk_void 508 end; 509 510tk(G, S, N, X) when is_record(X, enum) -> 511 N2 = [ic_forms:get_id2(X) | N], 512 tktab_add(G, S, N, X, 513 {tk_enum, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), 514 enum_body(G, S, N2, ic_forms:get_body(X))}); 515 516 517%% Note that the TK returned from this function is the base TK. It 518%% must be modified for each of the identifiers in the idlist (for 519%% array reasons). 520tk(G, S, N, X) when is_record(X, typedef) -> 521 case X of 522 %% Special case only for term and java backend ! 523 {typedef,{any,_},[{'<identifier>',_,"term"}],undefined} -> 524 case ic_options:get_opt(G, be) of 525 java -> 526 tktab_add(G, S, N, X, tk_term), 527 tk_term; 528 _ -> 529 TK = tk(G, S, N, ic_forms:get_body(X)), 530 lists:foreach(fun(Id) -> 531 tktab_add(G, S, N, #id_of{id=Id, type=X}, 532 maybe_array(G, S, N, Id, TK)) 533 end, 534 X#typedef.id), 535 TK 536 end; 537 _ -> 538 TK = tk(G, S, N, ic_forms:get_body(X)), 539 lists:foreach(fun(Id) -> 540 tktab_add(G, S, N, #id_of{id=Id, type=X}, 541 maybe_array(G, S, N, Id, TK)) 542 end, 543 X#typedef.id), 544 TK 545 end; 546 547tk(G, S, N, X) when is_record(X, struct) -> 548 N2 = [ic_forms:get_id2(X) | N], 549 tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), 550 tk_memberlist(G, S, N2, ic_forms:get_body(X))}); 551 552tk(G, S, N, X) when is_record(X, except) -> 553 N2 = [ic_forms:get_id2(X) | N], 554 tktab_add(G, S, N, X, {tk_except, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), 555 tk_memberlist(G, S, N2, ic_forms:get_body(X))}); 556 557tk(G, S, N, X) -> tk_base(G, S, N, X). 558 559 560tk_base(G, S, N, X) when is_record(X, sequence) -> 561 {tk_sequence, tk(G, S, N, X#sequence.type), 562 len_eval(G, S, N, X#sequence.length)}; 563 564tk_base(G, S, N, X) when is_record(X, string) -> 565 {tk_string, len_eval(G, S, N, X#string.length)}; 566 567tk_base(G, S, N, X) when is_record(X, wstring) -> %% WSTRING 568 {tk_wstring, len_eval(G, S, N, X#wstring.length)}; 569 570%% Fixed constants can be declared as: 571%% (1) const fixed pi = 3.14D; or 572%% (2) typedef fixed<3,2> f32; 573%% const f32 pi = 3.14D; 574tk_base(G, S, N, X) when is_record(X, fixed) -> 575 %% Case 2 576 {tk_fixed, len_eval(G, S, N, X#fixed.digits), len_eval(G, S, N, X#fixed.scale)}; 577tk_base(_G, _S, _N, {fixed, _}) -> 578 %% Case 1 579 tk_fixed; 580 581 582%% Special case, here CORBA::TypeCode is built in 583%% ONLY when erl_corba is the backend of choice 584tk_base(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) -> 585 case ic_options:get_opt(G, be) of 586 false -> 587 tk_TypeCode; 588 erl_corba -> 589 tk_TypeCode; 590 erl_template -> 591 tk_TypeCode; 592 _ -> 593 case scoped_lookup(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) of 594 T when element(1, T) == error -> T; 595 T when is_tuple(T) -> element(3, T) 596 end 597 end; 598 599tk_base(G, S, N, X) when element(1, X) == scoped_id -> 600 case scoped_lookup(G, S, N, X) of 601 T when element(1, T) == error -> T; 602 T when is_tuple(T) -> element(3, T) 603 end; 604tk_base(_G, _S, _N, {long, _}) -> tk_long; 605tk_base(_G, _S, _N, {'long long', _}) -> tk_longlong; %% LLONG 606tk_base(_G, _S, _N, {short, _}) -> tk_short; 607tk_base(_G, _S, _N, {'unsigned', {short, _}}) -> tk_ushort; 608tk_base(_G, _S, _N, {'unsigned', {long, _}}) -> tk_ulong; 609tk_base(_G, _S, _N, {'unsigned', {'long long', _}})-> tk_ulonglong; %% ULLONG 610tk_base(_G, _S, _N, {float, _}) -> tk_float; 611tk_base(_G, _S, _N, {double, _}) -> tk_double; 612tk_base(_G, _S, _N, {boolean, _}) -> tk_boolean; 613tk_base(_G, _S, _N, {char, _}) -> tk_char; 614tk_base(_G, _S, _N, {wchar, _}) -> tk_wchar; %% WCHAR 615tk_base(_G, _S, _N, {octet, _}) -> tk_octet; 616tk_base(_G, _S, _N, {null, _}) -> tk_null; 617tk_base(_G, _S, _N, {void, _}) -> tk_void; 618tk_base(_G, _S, _N, {any, _}) -> tk_any; 619tk_base(_G, _S, _N, {'Object', _}) -> {tk_objref, "", "Object"}. 620 621 622%%-------------------------------------------------------------------- 623%% 624%% Special handling of idlists. Note that the recursion case is given 625%% as accumulator to foldr. Idlists are those lists of identifiers 626%% that share the same definition, i.e. multiple cases, multiple type 627%% declarations, multiple member names. 628%% 629tk_memberlist(G, S, N, [X | Xs]) -> 630 BaseTK = tk(G, S, N, ic_forms:get_type(X)), 631 632 XX = #id_of{type=X}, 633 lists:foldr(fun(Id, Acc) -> 634 [tk_member(G, S, N, XX#id_of{id=Id}, BaseTK) | Acc] end, 635 tk_memberlist(G, S, N, Xs), 636 ic_forms:get_idlist(X)); 637tk_memberlist(_G, _S, _N, []) -> []. 638 639%% same as above but for case dcls 640tk_caselist(G, S, N, DiscrTK, Xs) -> 641 lists:foldl(fun(Case, Acc) -> 642 BaseTK = tk(G, S, N, ic_forms:get_type(Case)), 643 %% tktab_add for the uniqueness check of the declarator 644 tktab_add(G, S, N, Case), 645 lists:foldl(fun(Id, Acc2) -> 646 case tk_case(G, S, N, Case, BaseTK, 647 DiscrTK, Id) of 648 Err when element(1, Err)==error -> 649 Acc2; 650 TK -> 651 unique_add_case_label(G, S, N, Id, 652 TK, Acc2) 653 end 654 end, 655 Acc, 656 ic_forms:get_idlist(Case)) 657 end, 658 [], 659 Xs). 660 661 662%% Handling of the things that can be in an idlist or caselist 663tk_member(G, S, N, X, BaseTK) -> 664 tktab_add(G, S, N, X, 665 {ic_forms:get_id2(X), maybe_array(G, S, N, X#id_of.id, BaseTK)}). 666 667 668get_case_id_and_check(G, _S, _N, _X, ScopedId) -> 669 case ic_symtab:scoped_id_is_global(ScopedId) of 670 true -> ic_error:error(G, {bad_scope_enum_case, ScopedId}); 671 false -> ok 672 end, 673 case ic_symtab:scoped_id_strip(ScopedId) of 674 [Id] -> Id; 675 _List -> 676 ic_error:error(G, {bad_scope_enum_case, ScopedId}), 677 "" 678 end. 679 680 681tk_case(G, S, N, X, BaseTK, DiscrTK, Id) -> 682 case case_eval(G, S, N, DiscrTK, Id) of 683 Err when element(1, Err) == error -> Err; 684 Val -> 685 case iceval:check_tk(G, DiscrTK, Val) of 686 true -> 687 {iceval:get_val(Val), ic_forms:get_id2(X), 688 maybe_array(G, S, N, X#case_dcl.id, BaseTK)}; 689 false -> 690 ic_error:error(G, {bad_case_type, DiscrTK, X, 691 iceval:get_val(Val)}) 692 end 693 end. 694 695tktab_add(G, S, N, X) -> 696 tktab_add_id(G, S, N, X, ic_forms:get_id2(X), nil, nil). 697tktab_add(G, S, N, X, TK) -> 698 tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, nil). 699tktab_add(G, S, N, X, TK, Aux) -> 700 tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, Aux). 701 702 703tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,enumerator) -> 704 705 %% Check if the "scl" flag is set to true 706 %% if so, allow old semantics ( errornous ) 707 %% Warning, this is for compatibility reasons only. 708 Name = case ic_options:get_opt(G, scl) of 709 true -> 710 [Id | N]; 711 false -> 712 [Id | tl(N)] 713 end, 714 715 UName = mk_uppercase(Name), 716 case ets:lookup(S, Name) of 717 [_] -> ic_error:error(G, {multiply_defined, X}); 718 [] -> 719 case ets:lookup(S, UName) of 720 [] -> ok; 721 [_] -> ic_error:error(G, {illegal_spelling, X}) 722 end 723 end, 724 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 725 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 726 true -> true end, 727 TK; 728%% 729%% Fixes the multiple file module definition check 730%% but ONLY for Corba backend 731%% 732tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,module) -> 733 case ic_options:get_opt(G, be) of 734 erl_template -> 735 Name = [Id | N], 736 UName = mk_uppercase(Name), 737 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 738 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 739 true -> true end, 740 TK; 741 erl_corba -> 742 Name = [Id | N], 743 UName = mk_uppercase(Name), 744 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 745 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 746 true -> true end, 747 TK; 748 false -> %% default == erl_corba 749 Name = [Id | N], 750 UName = mk_uppercase(Name), 751 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 752 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 753 true -> true end, 754 TK; 755 java -> 756 Name = [Id | N], 757 UName = mk_uppercase(Name), 758 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 759 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 760 true -> true end, 761 TK; 762 erl_genserv -> 763 Name = [Id | N], 764 UName = mk_uppercase(Name), 765 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 766 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 767 true -> true end, 768 TK; 769 erl_plain -> 770 Name = [Id | N], 771 UName = mk_uppercase(Name), 772 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 773 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 774 true -> true end, 775 TK; 776 _Be -> 777 Name = [Id | N], 778 UName = mk_uppercase(Name), 779 case ets:lookup(S, Name) of 780 [_] -> ic_error:error(G, {multiply_defined, X}); 781 [] -> 782 case ets:lookup(S, UName) of 783 [] -> ok; 784 [_] -> ic_error:error(G, {illegal_spelling, X}) 785 end 786 end, 787 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 788 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 789 true -> true end, 790 TK 791 end; 792tktab_add_id(G, S, N, X, Id, TK, Aux) -> 793 Name = [Id | N], 794 UName = mk_uppercase(Name), 795 case ets:lookup(S, Name) of 796 [{_, forward, _, _}] when is_record(X, interface) -> 797 ok; 798 [{_, constr_forward, _, _}] when is_record(X, union) orelse 799 is_record(X, struct) -> 800 ok; 801 [XX] when is_record(X, forward) andalso element(2, XX)==interface -> 802 ok; 803 [_] -> 804 ic_error:error(G, {multiply_defined, X}); 805 [] -> 806 case ets:lookup(S, UName) of 807 [] -> ok; 808 [_] -> ic_error:error(G, {illegal_spelling, X}) 809 end 810 end, 811 ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), 812 if UName =/= Name -> ets:insert(S, {UName, spellcheck}); 813 true -> true end, 814 TK. 815 816 817 818 819%%-------------------------------------------------------------------- 820%% enum_body 821%% 822%% Special because ids are treated different than usual. 823%% 824enum_body(G, S, N, [Enum | EnumList]) -> 825 tktab_add(G, S, N, Enum), %%%, enum_val, Enum), 826 %% tktab_add(G, S, N, X, TK, V), 827 [ic_forms:get_id2(Enum) | enum_body(G, S, N, EnumList)]; 828enum_body(_G, _S, _N, []) -> []. 829 830 831%%-------------------------------------------------------------------- 832%% mk_array 833%% 834%% Multi dimensional arrays are written as nested tk_array 835%% 836mk_array(G, S, N, [Sz | Szs], TK) -> 837 case iceval:eval_const(G, S, N, positive_int, Sz) of 838 Err when element(1, Err) == error -> TK; 839 Val -> 840 {tk_array, mk_array(G, S, N, Szs, TK), iceval:get_val(Val)} 841 end; 842mk_array(_G, _S, _N, [], TK) -> TK. 843 844 845%%-------------------------------------------------------------------- 846%% len_eval 847%% 848%% Evaluates the length, which in case it has been left out is a 849%% plain 0 (zero) 850%% 851len_eval(_G, _S, _N, 0) -> 0; 852len_eval(G, S, N, X) -> %%iceval:eval_const(G, S, N, positive_int, X). 853 case iceval:eval_const(G, S, N, positive_int, X) of 854 Err when element(1, Err) == error -> 0; 855 Val -> iceval:get_val(Val) 856 end. 857 858 859%%-------------------------------------------------------------------- 860%% case_eval 861%% 862%% Evaluates the case label. 863%% 864 865case_eval(G, S, N, DiscrTK, X) when element(1, DiscrTK) == tk_enum, 866 element(1, X) == scoped_id -> 867 {tk_enum, _, _, Cases} = DiscrTK, 868 Id = get_case_id_and_check(G, S, N, X, X), 869 %%io:format("Matching: ~p to ~p~n", [Id, Cases]), 870 case lists:member(Id, Cases) of 871 true -> 872 {enum_id, Id}; 873 false -> 874 iceval:mk_val(scoped_lookup(G, S, N, X)) % Will generate error 875 end; 876 877case_eval(G, S, N, DiscrTK, X) -> 878 iceval:eval_e(G, S, N, DiscrTK, X). 879 880 881%% The enum declarator is in the union scope. 882do_special_enum(G, S, N, X) when is_record(X, enum) -> 883 tktab_add(G, S, N, #id_of{id=X#enum.id, type=X}); 884do_special_enum(_G, _S, _N, _X) -> 885 ok. 886 887 888unique_add_case_label(G, _S, _N, Id, TK, TKList) -> 889%%%io:format("check_case_labels: TK:~p TKLIST:~p ~n", [TK, TKList]), 890 if element(1, TK) == error -> 891 TKList; 892 true -> 893 case lists:keysearch(element(1, TK), 1, TKList) of 894 {value, _} -> 895 ic_error:error(G, {multiple_cases, Id}), 896 TKList; 897 false -> 898 [TK | TKList] 899 end 900 end. 901 902 903%%-------------------------------------------------------------------- 904%% default_count 905%% 906%% Returns the position of the default case. 907%% 908%% Modified for OTP-2007 909%% 910default_count(Xs) -> 911 default_count2(Xs, 0). 912 913default_count2([X | Xs], N) -> default_count3(X#case_dcl.label, Xs, N); 914default_count2([], _) -> -1. 915 916default_count3([{default, _} | _Ys], _Xs, N) -> N; 917default_count3([_ | Ys], Xs, N) -> default_count3(Ys, Xs, N+1); 918default_count3([], Xs, N) -> default_count2(Xs, N). 919 920 921 922 923%% 924%% Type checks. 925%% 926%% Check constant type references (only for the scoped id case, others 927%% are caught by the BNF) 928%% 929check_const_tk(_G, _S, _N, _X, tk_long) -> true; 930check_const_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG 931check_const_tk(_G, _S, _N, _X, tk_short) -> true; 932check_const_tk(_G, _S, _N, _X, tk_ushort) -> true; 933check_const_tk(_G, _S, _N, _X, tk_ulong) -> true; 934check_const_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG 935check_const_tk(_G, _S, _N, _X, tk_float) -> true; 936check_const_tk(_G, _S, _N, _X, tk_double) -> true; 937check_const_tk(_G, _S, _N, _X, tk_boolean) -> true; 938check_const_tk(_G, _S, _N, _X, tk_char) -> true; 939check_const_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR 940check_const_tk(_G, _S, _N, _X, tk_octet) -> true; 941check_const_tk(_G, _S, _N, _X, {tk_string, _Len}) -> true; 942check_const_tk(_G, _S, _N, _X, {tk_wstring, _Len}) -> true; %% WSTRING 943check_const_tk(_G, _S, _N, _X, tk_fixed) -> true; 944check_const_tk(_G, _S, _N, _X, {tk_fixed, _Digits, _Scale}) -> true; 945check_const_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_const_t, X, TK}). 946 947 948check_switch_tk(_G, _S, _N, _X, tk_long) -> true; 949check_switch_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG 950check_switch_tk(_G, _S, _N, _X, tk_short) -> true; 951check_switch_tk(_G, _S, _N, _X, tk_ushort) -> true; 952check_switch_tk(_G, _S, _N, _X, tk_ulong) -> true; 953check_switch_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG 954check_switch_tk(_G, _S, _N, _X, tk_boolean) -> true; 955check_switch_tk(_G, _S, _N, _X, tk_char) -> true; 956check_switch_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR 957check_switch_tk(_G, _S, _N, _X, TK) when element(1, TK) == tk_enum -> true; 958check_switch_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_switch_t, X, TK}), 959 false. 960 961 962 963%% Lookup a name 964name_lookup(G, S, N, X) -> 965 case scoped_lookup(G, S, N, X) of 966 T when is_tuple(T) -> element(1, T) 967 end. 968 969 970lookup(G, S, N, X, Id) -> 971 N2 = Id ++ N, 972 ?DBG(" Trying ~p ...~n", [N2]), 973 case ets:lookup(S, N2) of 974 [] -> 975 case look_for_interface(G, S, [hd(N2)], tl(N2)) of 976 977 %% First attempt: filtering inherited members ! 978 [{_, member, _, _}] -> 979 case look_for_interface(G, S, [hd(N)], tl(N2)) of 980 [T] -> 981 ?DBG(" -- found ~p~n", [T]), 982 T; 983 _ -> 984 lookup(G, S, tl(N), X, Id) 985 end; 986 %% 987 988 [T] -> 989 ?DBG(" -- found ~p~n", [T]), 990 T; 991 992 _ -> 993 if N == [] -> 994 ic_error:error(G, {tk_not_found, X}); 995 true -> 996 lookup(G, S, tl(N), X, Id) 997 end 998 999 end; 1000 1001 %% Second attempt: filtering members ! 1002 [{_, member, _, _}] -> 1003 case look_for_interface(G, S, [hd(N2)], tl(N2)) of 1004 [T] -> 1005 ?DBG(" -- found ~p~n", [T]), 1006 T; 1007 _ -> 1008 if N == [] -> 1009 ic_error:error(G, {tk_not_found, X}); 1010 true -> 1011 lookup(G, S, tl(N), X, Id) 1012 end 1013 end; 1014 %% 1015 [T] -> 1016 ?DBG(" -- found ~p~n", [T]), 1017 T 1018 end. 1019 1020 1021look_for_interface(_G, _S, _Hd, []) -> 1022 false; 1023look_for_interface(G, S, Hd, Tl) -> 1024 case ets:lookup(S, Tl) of 1025 [{_, interface, _TK, Inh}] -> 1026 case look_in_inherit(G, S, Hd, Inh) of 1027 %% gather_inherit(G, S, Inh, [])) of 1028 [X] when is_tuple(X) -> 1029 [X]; 1030 _ -> 1031 look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl)) 1032 end; 1033 _ -> 1034 look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl)) 1035 end. 1036 1037look_in_inherit(G, S, Id, [I | Is]) -> 1038 case ets:lookup(S, Id ++ I) of 1039 [X] when is_tuple(X) -> 1040 [X]; 1041 [] -> 1042 look_in_inherit(G, S, Id, Is) 1043 end; 1044look_in_inherit(_G, _S, _Id, []) -> 1045 false. 1046 1047 1048%% L is a list of names 1049mk_uppercase(L) -> 1050 lists:map(fun(Z) -> lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; 1051 (X) -> X end, Z) end, L). 1052 1053 1054%%-------------------------------------------------------------------- 1055%% 1056%% Inheritance stuff 1057%% 1058%% 1059%%-------------------------------------------------------------------- 1060 1061%% InhBody is an accumulating parameter 1062 1063calc_inherit_body(G, N, OrigBody, [X|Xs], InhBody) -> 1064 case ic_symtab:retrieve(G, X) of 1065 Intf when is_record(Intf, interface) -> 1066 Body = filter_body(G, X, ic_forms:get_body(Intf), N, OrigBody, InhBody), 1067 calc_inherit_body(G, N, OrigBody, Xs, [{X, Body} | InhBody]); 1068 XXX -> 1069 io:format("Oops, not found ~p~n", [XXX]), 1070 calc_inherit_body(G, N, OrigBody, Xs, InhBody) 1071 end; 1072calc_inherit_body(_G, _N, _OrigBody, [], InhBody) -> lists:reverse(InhBody). 1073 1074 1075filter_body(G, XPath, [X | Xs], OrigPath, OrigBody, InhBody) -> 1076 case complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) of 1077 true -> 1078 %%io:format("NOT adding ~p~n", [ic_forms:get_id2(X)]), 1079 filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody); 1080 {false, NewX} -> % For those with idlist 1081 %%io:format("Adding from idlist~n", []), 1082 [NewX | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)]; 1083 false -> 1084 %%io:format("Adding: ~p~n", [ic_forms:get_id2(X)]), 1085 [X | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)] 1086 end; 1087filter_body(_G, _XPath, [], _OrigPath, _OrigBody, _InhBody) -> []. 1088 1089 1090complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> 1091 case has_idlist(X) of 1092 true -> 1093 idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody); 1094 false -> 1095 straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) 1096 end. 1097 1098 1099idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> 1100 XX = #id_of{type=X}, 1101 F = fun(Id) -> 1102 not(straight_member(G, XPath, XX#id_of{id=Id}, OrigPath, 1103 OrigBody, InhBody)) 1104 end, 1105 case lists:filter(F, ic_forms:get_idlist(X)) of 1106 [] -> 1107 true; 1108 IdList -> 1109%%% io:format("Idlist added: ~p~n",[IdList]), 1110 {false, replace_idlist(X, IdList)} 1111 end. 1112 1113 1114straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> 1115 %%io:format("straight member: ~p~n", [ic_forms:get_id2(X)]), 1116 case body_member(G, XPath, X, OrigPath, OrigBody) of 1117 true -> 1118 true; 1119 false -> 1120 inh_body_member(G, XPath, X, InhBody) 1121 end. 1122 1123 1124inh_body_member(G, XPath, X, [{Name, Body} | InhBody]) -> 1125 case body_member(G, XPath, X, Name, Body) of 1126 true -> 1127 true; 1128 false -> 1129 inh_body_member(G, XPath, X, InhBody) 1130 end; 1131inh_body_member(_G, _XPath, _X, []) -> false. 1132 1133 1134body_member(G, XPath, X, YPath, [Y|Ys]) -> 1135 case has_idlist(Y) of 1136 true -> 1137 YY = #id_of{type=Y}, 1138 case list_and(fun(Y2) -> 1139 not(is_equal(G, XPath, X, YPath, 1140 YY#id_of{id=Y2})) end, 1141 ic_forms:get_idlist(Y)) of 1142 true -> 1143 body_member(G, XPath, X, YPath, Ys); 1144 false -> 1145 true 1146 end; 1147 false -> 1148 case is_equal(G, XPath, X, YPath, Y) of 1149 false -> 1150 body_member(G, XPath, X, YPath, Ys); 1151 true -> 1152 true 1153 end 1154 end; 1155body_member(_G, _XPath, _X, _YPath, []) -> false. 1156 1157 1158is_equal(G, XPath, X, YPath, Y) -> 1159 case {ic_forms:get_id2(X), ic_forms:get_id2(Y)} of 1160 {ID, ID} -> 1161 collision(G, XPath, X, YPath, Y), 1162 true; 1163 _ -> 1164 false 1165 end. 1166 1167 1168%% X is the new item, Y is the old one. So it is X that collides with 1169%% Y and Y shadows X. 1170collision(G, XPath, X, YPath, Y) -> 1171 I1 = get_beef(X), 1172 % I2 = get_beef(Y), 1173 if is_record(I1, op) -> %%, record(I2, op) -> 1174 ic_error:error(G, {inherit_name_collision, 1175 {YPath, Y}, {XPath, X}}); 1176 is_record(I1, attr) -> %%, record(I2, attr) -> 1177 ic_error:error(G, {inherit_name_collision, 1178 {YPath, Y}, {XPath, X}}); 1179 true -> 1180 ?ifopt(G, warn_name_shadow, 1181 ic_error:warn(G, {inherit_name_shadow, 1182 {YPath, Y}, {XPath, X}})) 1183 end. 1184 1185has_idlist(X) when is_record(X, typedef) -> true; 1186has_idlist(X) when is_record(X, member) -> true; 1187has_idlist(X) when is_record(X, case_dcl) -> true; 1188has_idlist(X) when is_record(X, attr) -> true; 1189has_idlist(_) -> false. 1190 1191replace_idlist(X, IdList) when is_record(X, typedef) -> X#typedef{id=IdList}; 1192replace_idlist(X, IdList) when is_record(X, attr) -> X#attr{id=IdList}. 1193 1194get_beef(X) when is_record(X, id_of) -> X#id_of.type; 1195get_beef(X) -> X. 1196 1197 1198%% And among all elements in list 1199list_and(F, [X|Xs]) -> 1200 case F(X) of 1201 true -> list_and(F, Xs); 1202 false -> false 1203 end; 1204list_and(_F, []) -> true. 1205 1206 1207 1208 1209 1210%%-------------------------------------------------------------------- 1211%% 1212%% resolve_inherit shall return a list of resolved inheritances, 1213%% that is all names replaced with their global names. 1214%% 1215 1216inherit_resolve(G, S, N, [X|Rest], Out) -> 1217 case scoped_lookup(G, S, N, X) of 1218 {Name, _T, _TK, Inh} -> 1219 case lists:member(Name, Out) of 1220 true -> 1221 inherit_resolve(G, S, N, Rest, Out); 1222 false -> 1223 case unique_append(Inh, [Name|Out]) of 1224 error -> 1225 ic_error:error(G, {inherit_resolve, X, Name}), 1226 inherit_resolve(G, S, N, Rest, []); 1227 UA -> 1228 inherit_resolve(G, S, N, Rest, UA) 1229 end 1230 end; 1231 _ -> inherit_resolve(G, S, N, Rest, Out) 1232 end; 1233inherit_resolve(_G, _S, _N, [], Out) -> lists:reverse(Out). 1234 1235unique_append([X|Xs], L) -> 1236 case lists:member(X, L) of 1237 true -> unique_append(Xs, L); 1238 false -> unique_append(Xs, [X|L]) 1239 end; 1240unique_append([], L) -> L; 1241%% Error 1242unique_append(_, _L) -> error. 1243 1244 1245 1246 1247%%-------------------------------------------------------------------- 1248%% 1249%% Utilities 1250%% 1251 1252%% Must preserve order, therefore had to write my own (instead of lists:map) 1253check_list(G, S, N, [X|Xs]) -> 1254 X1 = check(G, S, N, X), 1255 [X1 | check_list(G, S, N, Xs)]; 1256check_list(_G, _S, _N, []) -> []. 1257 1258 1259 1260filter( [] ) -> 1261 error; 1262filter( [I | Is ] ) -> 1263 case I of 1264 { _, member, { _, TKINFO }, _ } -> 1265 fetchType( TKINFO ); 1266 1267 { _, struct, _, _ } -> 1268 struct; 1269 1270 { _, typedef, TKINFO, _ } -> 1271 fetchType( TKINFO ); 1272 1273 { _, module, _, _ } -> 1274 module; 1275 1276 { _, interface, _, _ } -> 1277 interface; 1278 1279 { _, op, _, _ } -> 1280 op; 1281 1282 { _,enum, _, _ } -> 1283 enum; 1284 1285 { _, spellcheck } -> 1286 filter( Is ); 1287 1288 _ -> 1289 error 1290 end. 1291 1292 1293fetchType( { tk_sequence, _, _ } ) -> 1294 sequence; 1295fetchType( { tk_array, _, _ } ) -> 1296 array; 1297fetchType( { tk_struct, _, _, _} ) -> 1298 struct; 1299fetchType( { tk_string, _} ) -> 1300 string; 1301fetchType( { tk_wstring, _} ) -> %% WSTRING 1302 wstring; 1303fetchType( { tk_fixed, _, _} ) -> 1304 fixed; 1305fetchType( tk_short ) -> 1306 short; 1307fetchType( tk_long ) -> 1308 long; 1309fetchType( tk_longlong ) -> %% LLONG 1310 longlong; 1311fetchType( tk_ushort ) -> 1312 ushort; 1313fetchType( tk_ulong ) -> 1314 ulong; 1315fetchType( tk_ulonglong ) -> %% ULLONG 1316 ulonglong; 1317fetchType( tk_float ) -> 1318 float; 1319fetchType( tk_double ) -> 1320 double; 1321fetchType( tk_boolean ) -> 1322 boolean; 1323fetchType( tk_char ) -> 1324 char; 1325fetchType( tk_wchar ) -> %% WCHAR 1326 wchar; 1327fetchType( tk_octet ) -> 1328 octet; 1329fetchType( { tk_enum, _, _, _ } ) -> 1330 enum; 1331fetchType( { tk_union, _, _, _, _, _ } ) -> 1332 union; 1333fetchType( tk_any ) -> 1334 any; 1335fetchType( _ ) -> 1336 error. 1337 1338%% Z is a single name 1339to_uppercase(Z) -> 1340 lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; 1341 (X) -> X end, Z). 1342 1343 1344%%------------------------------------------------------------ 1345%% 1346%% Always fetchs TK of a record. 1347%% 1348%%------------------------------------------------------------ 1349fetchTk(G,N,X) -> 1350 case ic_forms:get_tk(X) of 1351 undefined -> 1352 searchTk(G,ictk:get_IR_ID(G, N, X)); 1353 TK -> 1354 TK 1355 end. 1356 1357 1358%%------------------------------------------------------------ 1359%% 1360%% seek type code when not accessible by get_tk/1 1361%% 1362%%------------------------------------------------------------ 1363searchTk(G,IR_ID) -> 1364 S = ic_genobj:tktab(G), 1365 case catch searchTk(S,IR_ID,typedef) of 1366 {value,TK} -> 1367 TK; 1368 _ -> %% false / exit 1369 case catch searchTk(S,IR_ID,struct) of 1370 {value,TK} -> 1371 TK; 1372 _ -> %% false / exit 1373 case catch searchTk(S,IR_ID,union) of 1374 {value,TK} -> 1375 TK; 1376 _ -> 1377 undefined 1378 end 1379 end 1380 end. 1381 1382 1383searchTk(S,IR_ID,Type) -> 1384 L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), 1385 case lists:keysearch(IR_ID,2,L) of 1386 {value,TK} -> 1387 {value,TK}; 1388 false -> 1389 searchInsideTks(L,IR_ID) 1390 end. 1391 1392 1393searchInsideTks([],_IR_ID) -> 1394 false; 1395searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) -> 1396 case searchIncludedTk(TK,IR_ID) of 1397 {value,TK} -> 1398 {value,TK}; 1399 false -> 1400 searchInsideTks(Xs,IR_ID) 1401 end. 1402 1403 1404searchIncludedTk({tk_array,TK,_},IR_ID) -> 1405 searchIncludedTk(TK,IR_ID); 1406searchIncludedTk({tk_sequence,TK,_},IR_ID) -> 1407 searchIncludedTk(TK,IR_ID); 1408searchIncludedTk(TK, _IR_ID) when is_atom(TK) -> 1409 false; 1410searchIncludedTk(TK,IR_ID) -> 1411 case element(2,TK) == IR_ID of 1412 true -> 1413 {value,TK}; 1414 false -> 1415 false 1416 end. 1417 1418