%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
%%
-module(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.
