ictype.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,412 行 · 第 1/3 页

    ?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 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 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 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 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 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 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 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 record(X, string) ->
    {tk_string, len_eval(G, S, N, X#string.length)};

tk_base(G, S, N, X) when 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 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 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 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 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 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 record(X, interface) -> ok;
	[XX] when record(X, forward), 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 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;