iceval.erl

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

%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
-module(iceval).

-include("icforms.hrl").

-export([eval_const/5, eval_e/5]).

-export([check_tk/3, get_val/1, mk_val/1]).

-define(get_max(__X, __Y), if __X > __Y -> __X; true -> __Y end).
-define(get_min(__X, __Y), if __X > __Y -> __Y; true -> __X end).

-define(BASE, 100000000000000000000000000000000).
-define(FIXED_MAX, 9999999999999999999999999999999).

%% Called fr: ictype 99, 522, 533
%% Fixed constants can be declared as:
%% (1)  const fixed pi = 3.14D; or
%% (2)  typedef fixed<3,2> f32;
%%      const f32 pi = 3.14D;
%% Hence, if fixed is declared as (1) we must handle it especially.
eval_const(G, S, N, tk_fixed, Expr) ->
    case catch eval_e(G, S, N, tk_fixed, Expr) of
	T when element(1, T) == error -> 0;
	V when record(V, fixed) -> 
	    {ok, {tk_fixed, V#fixed.digits, V#fixed.scale}, V};
	V ->
	    ic_error:error(G, {bad_tk_match, Expr, tk_fixed, get_val(V)})		      
    end;
eval_const(G, S, N, TK, Expr) ->
    case catch eval_e(G, S, N, TK, Expr) of
	T when element(1, T) == error -> 0;
	V -> 
	    case check_tk(G, TK, V) of
		true -> ok;
		false ->
		    ic_error:error(G, {bad_tk_match, Expr, TK, get_val(V)})
	    end,
	    get_val(V)
    end.


check_op(G, S, N, Tk, Types, Op, E1, E2) ->
    V1 = eval_e(G, S, N, Tk, E1),
    V2 = eval_e(G, S, N, Tk, E2),
    check_types(G, Op, E1, Types, V1),
    check_types(G, Op, E2, Types, V2),
    case check_comb(V1, V2) of
	true ->
	    {V1, V2};
	false ->
	    Err = {bad_type_combination, E1, get_val(V1), get_val(V2)},
	    ic_error:error(G, Err),
	    throw({error, Err})
    end.

check_op(G, S, N, Tk, Types, Op, E1) ->
    V1 = eval_e(G, S, N, Tk, E1),
    check_types(G, Op, E1, Types, V1),
    V1.

%% Match the declared type TK against the factual value of an constant
%%
check_tk(_G, _Any, default) -> true;		% Default case in union
check_tk(_G, positive_int, V) when integer(V), V >= 0 -> true;
check_tk(_G, tk_long, V) when integer(V) -> true;
check_tk(_G, tk_longlong, V) when integer(V) -> true;  %% LLON_G
check_tk(_G, tk_short, V) when integer(V) -> true;
check_tk(_G, tk_ushort, V) when integer(V), V >= 0 -> true;
check_tk(_G, tk_ulong, V) when integer(V), V >= 0 -> true;
check_tk(_G, tk_ulonglong, V) when integer(V), V >= 0 -> true;  %% ULLON_G
check_tk(_G, tk_float, V) when float(V) -> true;
check_tk(_G, tk_double, V) when float(V) -> true;
check_tk(_G, tk_boolean, V) -> is_bool(V);
check_tk(_G, tk_char, {char, _V}) -> true;
check_tk(_G, tk_wchar, {wchar, _V}) -> true; %% WCHAR
check_tk(_G, {tk_string, _Len}, {string, _V}) -> true;
check_tk(_G, {tk_wstring, _Len}, {wstring, _V}) -> true;  %% WSTRING
check_tk(_G, {tk_fixed, Digits, Scale}, {fixed, Digits, Scale, _V}) -> true;
check_tk(_G, tk_octet, V) when integer(V) -> true;
%%check_tk(_G, tk_null, V) when integer(V) -> true;
%%check_tk(_G, tk_void, V) when integer(V) -> true;
%%check_tk(_G, tk_any, V) when integer(V) -> true;
%%check_tk(_G, {tk_objref, "", "Object"}, V) when integer(V) -> true.
check_tk(_G, {tk_enum, _, _, Body}, {enum_id, Id}) -> 
    until(fun(X) when X == Id -> true;
	     (_X) -> 
		  false 
	  end, Body);
check_tk(_G, _TK, _V) ->
    false.

get_val({string, X}) -> X;
get_val({wstring, X}) -> X;  %% WCHAR
get_val({char, X}) -> X;
get_val({wchar, X}) -> X;  %% WSTRING
get_val({enum_id, X}) -> X;
get_val(X) -> X.

check_types(G, Op, Expr, TypeList, V) ->
    case until(fun(int) when integer(V) -> true;
		  (float) when float(V) -> true;
		  (bool) when V==true -> true;
		  (bool) when V==false -> true;
		  (fixed) when record(V, fixed) -> true;
		  (_) -> false end,
	       TypeList) of
	true -> true;
	false ->
	    Err = {bad_type, Expr, Op, TypeList, V},
	    ic_error:error(G, Err),
	    throw({error, Err})
    end.

%%get_op(T) when tuple(T) -> element(1, T).

%% Should be in lists
until(F, [H|T]) ->
    case F(H) of
	true -> true;
	false -> until(F, T)
    end;
until(_F, []) -> false.

%% Section of all the boolean operators (because Erlang ops don't like
%% boolean values.
e_or(X, Y) when integer(X), integer(Y) -> X bor Y;
e_or(true, _) -> true;
e_or(_, true) -> true;
e_or(_, _) -> false.

e_and(X, Y) when integer(X), integer(Y) -> X band Y;
e_and(true, true) -> true;
e_and(_, _) -> false.

e_xor(X, Y) when integer(X), integer(Y) -> X bxor Y;
e_xor(X, X) -> false;
e_xor(_, _) -> true.

%% Handling infix operators (+,-,*,/) for fixed type.
%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)>
e_fixed_add(#fixed{digits = D1, scale = S1, value = V1}, 
	    #fixed{digits = D2, scale = S2, value = V2}) ->
    Scale = ?get_max(S1, S2),
    Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1,
    %% We must normalize the values before adding. Why?
    %% 4.23 and 5.2 are represented as 423 and 52. To be able to get the 
    %% correct result we must add 4230 and 5200 == 9430.
    {PV1, PV2} = normalize(S1, V1, S2, V2),
    check_fixed_overflow(#fixed{digits = Digits, 
				scale = Scale, 
				value = (PV1 + PV2)}).

%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)>
e_fixed_sub(#fixed{digits = D1, scale = S1, value = V1}, 
	    #fixed{digits = D2, scale = S2, value = V2}) ->
    Scale = ?get_max(S1, S2),
    Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1,
    {PV1, PV2} = normalize(S1, V1, S2, V2),
    check_fixed_overflow(#fixed{digits = Digits, 
				scale = Scale, 
				value = (PV1 - PV2)}).

%% Boundries determined as fixed<d1+d2, s1+s2>
e_fixed_mul(#fixed{digits = D1, scale = S1, value = V1}, 
	    #fixed{digits = D2, scale = S2, value = V2}) ->
    check_fixed_overflow(#fixed{digits = (D1+D2), 
				scale = (S1+S2), 
				value = V1*V2}).

%% Boundries determined as fixed<(d1-s1+s2) + s inf ,s inf>
e_fixed_div(#fixed{digits = D1, scale = S1, value = V1}, 
	    #fixed{digits = _D2, scale = S2, value = V2}) ->
    {PV1, PV2} = normalize(S1, V1, S2, V2),
    DigitsMin = (D1-S1+S2),
    R1 = (PV1 div PV2),
    R2 = (R1*?BASE + (PV1 rem PV2) * (?BASE div PV2)),
    {Result2, Sinf} = delete_zeros_value(R2, 0, R1),
    check_fixed_overflow(#fixed{digits = DigitsMin + Sinf, scale = Sinf, 
				value = Result2}).


%% Checks combination of argument types, basically floats and ints are
%% interchangeable, and all types are allowed with themselves. No
%% other combinations are allowed
%%
check_comb(X, Y) when integer(X), integer(Y) -> true;
check_comb(X, Y) when float(X), integer(Y) -> true;
check_comb(X, Y) when integer(X), float(Y) -> true;
check_comb(X, Y) when float(X), float(Y) -> true;
check_comb({X, _}, {X, _}) -> true;		% Strings and chars are tuples
check_comb({fixed, _, _, _}, {fixed, _, _, _}) -> true;
check_comb(X, Y) ->
    case {is_bool(X), is_bool(Y)} of
	{true, true} -> 
	    true;
	_ -> 
	    false
    end.

is_bool(true) -> true;
is_bool(false) -> true;
is_bool(_) -> false.


%%%% (15)
eval_e(G, S, N, Tk, {'or', T1, T2}) ->
    {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'or', T1, T2),
    e_or(E1, E2);

%%%% (16)
eval_e(G, S, N, Tk, {'xor', T1, T2}) ->
    {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'xor', T1, T2),
    e_xor(E1, E2);

%%%% (17)
eval_e(G, S, N, Tk, {'and', T1, T2}) ->
    {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'and', T1, T2),
    e_and(E1, E2);

%%%% (18)
eval_e(G, S, N, Tk, {'rshift', T1, T2}) ->
    {E1, E2} = check_op(G, S, N, Tk,  [int], 'rshift', T1, T2),
    E1 bsr E2;
eval_e(G, S, N, Tk, {'lshift', T1, T2}) ->
    {E1, E2} = check_op(G, S, N, Tk, [int], 'lshift', T1, T2),
    E1 bsl E2;

%%%% (19)
eval_e(G, S, N, Tk, {'+', T1, T2}) ->
    case check_op(G, S, N, Tk, [int, float, fixed], '+', T1, T2) of
	{F1, F2} when record(F1,fixed), record(F2,fixed) ->
	    e_fixed_add(F1, F2);
	{E1, E2} ->
	    E1 + E2
    end;
eval_e(G, S, N, Tk, {'-', T1, T2}) ->
    case check_op(G, S, N, Tk, [int, float, fixed], '-', T1, T2) of
	{F1, F2} when record(F1,fixed), record(F2,fixed) ->
	    e_fixed_sub(F1, F2);
	{E1, E2} ->
	    E1 - E2
    end;

%%%% (20)
eval_e(G, S, N, Tk, {'*', T1, T2}) ->
    case check_op(G, S, N, Tk, [int, float, fixed], '*', T1, T2) of
	{F1, F2} when record(F1,fixed), record(F2,fixed) ->
	    e_fixed_mul(F1, F2);
	{E1, E2} ->
	    E1 * E2
    end;
eval_e(G, S, N, Tk, {'/', T1, T2}) ->
    case check_op(G, S, N, Tk, [int, float, fixed], '/', T1, T2) of
	{F1, F2} when record(F1,fixed), record(F2,fixed) ->
	    e_fixed_div(F1, F2);
	{E1, E2} ->
	    E1 / E2
    end;
eval_e(G, S, N, Tk, {'%', T1, T2}) ->
    {E1, E2} = check_op(G, S, N, Tk, [int], '%', T1, T2),