erl_eval.erl

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

%% -*- erlang-indent-level: 4 -*-
%% ``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(erl_eval).

-compile(bitlevel_binaries).

%% An evaluator for Erlang abstract syntax.

-export([exprs/2,exprs/3,exprs/4,expr/2,expr/3,expr/4,
         expr_list/2,expr_list/3,expr_list/4]).
-export([new_bindings/0,bindings/1,binding/2,add_binding/3,del_binding/2]).

-export([is_constant_expr/1, partial_eval/1]).

%% Is used by standalone Erlang (escript).
%% Also used by shell.erl.
-export([match_clause/4]).

%% The following exports are here for backwards compatibility.
-export([seq/2,seq/3,arg_list/2,arg_list/3]).
-deprecated([{seq,2},{seq,3},{arg_list,2},{arg_list,3}]).

-export([check_command/2, fun_data/1]).

-import(lists, [reverse/1,foldl/3,member/2]).

%% seq(ExpressionSeq, Bindings)
%% seq(ExpressionSeq, Bindings, LocalFuncHandler)
%% arg_list(ExpressionList, Bindings)
%% arg_list(ExpressionList, Bindings, LocalFuncHandler)
%%  These calls are here for backwards compatibility.

seq(Exprs, Bs)     -> exprs(Exprs, Bs).
seq(Exprs, Bs, Lf) -> exprs(Exprs, Bs, Lf).

arg_list(Es, Bs)     -> expr_list(Es, Bs).
arg_list(Es, Bs, Lf) -> expr_list(Es, Bs, Lf).

%% exprs(ExpressionSeq, Bindings)
%% exprs(ExpressionSeq, Bindings, LocalFuncHandler)
%% exprs(ExpressionSeq, Bindings, LocalFuncHandler, ExternalFuncHandler)
%%  Returns:
%%	{value,Value,NewBindings}
%%    or {'EXIT', Reason}
%% Only exprs/2 checks the command by calling erl_lint. The reason is
%% that if there is a function handler present, then it is possible
%% that there are valid constructs in Expression to be taken care of
%% by a function handler but considerad errors by erl_lint.

exprs(Exprs, Bs) ->
    case check_command(Exprs, Bs) of
        ok -> 
            exprs(Exprs, Bs, none, none, none);
        {error,{_Line,_Mod,Error}} ->
	    erlang:raise(error, Error, [{?MODULE,exprs,2}])
    end.

exprs(Exprs, Bs, Lf) ->
    exprs(Exprs, Bs, Lf, none, none).

exprs(Exprs, Bs, Lf, Ef) ->
    exprs(Exprs, Bs, Lf, Ef, none).

exprs([E], Bs0, Lf, Ef, RBs) ->
    expr(E, Bs0, Lf, Ef, RBs);
exprs([E|Es], Bs0, Lf, Ef, RBs) ->
    RBs1 = none,
    {value,_V,Bs} = expr(E, Bs0, Lf, Ef, RBs1),
    exprs(Es, Bs, Lf, Ef, RBs).

%% expr(Expression, Bindings)
%% expr(Expression, Bindings, LocalFuncHandler)
%% expr(Expression, Bindings, LocalFuncHandler, ExternalFuncHandler)
%%  Returns:
%%	 {value,Value,NewBindings}
%%    or {'EXIT', Reason}
%%
%% Only expr/2 checks the command by calling erl_lint. See exprs/2.

expr(E, Bs) ->
    case check_command([E], Bs) of
        ok -> 
            expr(E, Bs, none, none, none);
        {error,{_Line,_Mod,Error}} ->
	    erlang:raise(error, Error, [{?MODULE,expr,2}])
    end.

expr(E, Bs, Lf) ->
    expr(E, Bs, Lf, none, none).

expr(E, Bs, Lf, Ef) ->
    expr(E, Bs, Lf, Ef, none).

%% Check a command (a list of expressions) by calling erl_lint.

check_command(Es, Bs) ->
    Opts = case eval_bits:bitlevel_binaries_enabled() of
	       false -> [];
	       true -> [bitlevel_binaries,binary_comprehension]
	   end,
    case erl_lint:exprs_opt(Es, bindings(Bs), Opts) of
        {ok,_Ws} ->
            ok;
        {error,[{_File,[Error|_]}],_Ws} ->
            {error,Error}
    end.

%% Check whether a term F is a function created by this module.
%% Returns 'false' if not, otherwise {fun_data,Imports,Clauses}.

fun_data(F) when is_function(F) ->
    case erlang:fun_info(F, module) of
        {module,erl_eval} ->
            {env, [FBs,_FEf,_FLf,FCs]} = erlang:fun_info(F, env),
            {fun_data,FBs,FCs};
        _ ->
            false
    end;
fun_data(_T) ->
    false.

expr({var,_,V}, Bs, _Lf, _Ef, RBs) ->
    case binding(V, Bs) of
	{value,Val} ->
            ret_expr(Val, Bs, RBs);
	unbound -> % Should not happen.
	    erlang:raise(error, {unbound,V}, stacktrace())
    end;
expr({char,_,C}, Bs, _Lf, _Ef, RBs) ->
    ret_expr(C, Bs, RBs);
expr({integer,_,I}, Bs, _Lf, _Ef, RBs) ->
    ret_expr(I, Bs, RBs);
expr({float,_,F}, Bs, _Lf, _Ef, RBs) ->
    ret_expr(F, Bs, RBs);
expr({atom,_,A}, Bs, _Lf, _Ef, RBs) ->
    ret_expr(A, Bs, RBs);
expr({string,_,S}, Bs, _Lf, _Ef, RBs) ->
    ret_expr(S, Bs, RBs);
expr({nil, _}, Bs, _Lf, _Ef, RBs) ->
    ret_expr([], Bs, RBs);
expr({cons,_,H0,T0}, Bs0, Lf, Ef, RBs) ->
    {value,H,Bs1} = expr(H0, Bs0, Lf, Ef, none),
    {value,T,Bs2} = expr(T0, Bs0, Lf, Ef, none),
    ret_expr([H|T], merge_bindings(Bs1, Bs2), RBs);
expr({lc,_,E,Qs}, Bs, Lf, Ef, RBs) ->
    eval_lc(E, Qs, Bs, Lf, Ef, RBs);
expr({bc,_,E,Qs}, Bs, Lf, Ef, RBs) ->
    eval_bc(E, Qs, Bs, Lf, Ef, RBs);
expr({tuple,_,Es}, Bs0, Lf, Ef, RBs) ->
    {Vs,Bs} = expr_list(Es, Bs0, Lf, Ef),
    ret_expr(list_to_tuple(Vs), Bs, RBs);
expr({record_field,_,_,_}=Mod, Bs, _Lf, _Ef, RBs) ->
    case expand_module_name(Mod, Bs) of
	{atom,_,A} ->
	    ret_expr(A, Bs, RBs);    %% This is the "x.y" syntax
	_ ->
	    erlang:raise(error, {badexpr, '.'}, stacktrace())
    end;
expr({record_field,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
    erlang:raise(error, {undef_record,Name}, stacktrace());
expr({record_index,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
    erlang:raise(error, {undef_record,Name}, stacktrace());
expr({record,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
    erlang:raise(error, {undef_record,Name}, stacktrace());
expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
    erlang:raise(error, {undef_record,Name}, stacktrace());
expr({block,_,Es}, Bs, Lf, Ef, RBs) ->
    exprs(Es, Bs, Lf, Ef, RBs);
expr({'if',_,Cs}, Bs, Lf, Ef, RBs) ->
    if_clauses(Cs, Bs, Lf, Ef, RBs);
expr({'case',_,E,Cs}, Bs0, Lf, Ef, RBs) ->
    {value,Val,Bs} = expr(E, Bs0, Lf, Ef, none),
    case_clauses(Val, Cs, Bs, Lf, Ef, RBs);
expr({'try',_,B,Cases,Catches,AB}, Bs, Lf, Ef, RBs) ->
    try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs);
expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) ->
    receive_clauses(Cs, Bs, Lf, Ef, [], RBs);
expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) ->
    {value,T,Bs} = expr(E, Bs0, Lf, Ef, none),
    receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs);
expr({'fun',_Line,{function,Mod,Name,Arity}}, Bs, _Lf, _Ef, RBs) ->
    F = erlang:make_fun(Mod, Name, Arity),
    ret_expr(F, Bs, RBs);    
expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8
    %% Don't know what to do...
    erlang:raise(error, undef, [{erl_eval,Name,Arity}|stacktrace()]);
expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) ->
    %% Save only used variables in the function environment.
    %% {value,L,V} are hidden while lint finds used variables.
    {Ex1, _} = hide_calls(Ex, 0),
    {ok,Used} = erl_lint:used_vars([Ex1], Bs),
    En = orddict:filter(fun(K,_V) -> member(K,Used) end, Bs),
    %% This is a really ugly hack!
    F = 
    case length(element(3,hd(Cs))) of
	0 -> fun () -> eval_fun(Cs, [], En, Lf, Ef) end;
	1 -> fun (A) -> eval_fun(Cs, [A], En, Lf, Ef) end;
	2 -> fun (A,B) -> eval_fun(Cs, [A,B], En, Lf, Ef) end;
	3 -> fun (A,B,C) -> eval_fun(Cs, [A,B,C], En, Lf, Ef) end;
	4 -> fun (A,B,C,D) -> eval_fun(Cs, [A,B,C,D], En, Lf, Ef) end;
	5 -> fun (A,B,C,D,E) -> eval_fun(Cs, [A,B,C,D,E], En, Lf, Ef) end;
	6 -> fun (A,B,C,D,E,F) -> eval_fun(Cs, [A,B,C,D,E,F], En, Lf, Ef) end;
	7 -> fun (A,B,C,D,E,F,G) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G], En, Lf, Ef) end;
	8 -> fun (A,B,C,D,E,F,G,H) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H], En, Lf, Ef) end;
	9 -> fun (A,B,C,D,E,F,G,H,I) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I], En, Lf, Ef) end;
	10 -> fun (A,B,C,D,E,F,G,H,I,J) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J], En, Lf, Ef) end;
	11 -> fun (A,B,C,D,E,F,G,H,I,J,K) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K], En, Lf, Ef) end;
	12 -> fun (A,B,C,D,E,F,G,H,I,J,K,L) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L], En, Lf, Ef) end;
	13 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M], En, Lf, Ef) end;
	14 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N], En, Lf, Ef) end;
	15 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], En, Lf, Ef) end;
	16 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], En, Lf, Ef) end;
	17 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], En, Lf, Ef) end;
	18 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], En, Lf, Ef) end;
	19 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S], 
                    En, Lf, Ef) end;
	20 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> 
           eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], 
                    En, Lf, Ef) end;
	_Other ->
	    erlang:raise(error, {'argument_limit',{'fun',Line,Cs}},
			 stacktrace())
    end,
    ret_expr(F, Bs, RBs);
expr({call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[{lc,_,_E,_Qs}=LC | As0]}, 
     Bs0, Lf, Ef, RBs) when length(As0) =< 1 ->
    %% No expansion or evaluation of module name or function name.
    MaxLine = find_maxline(LC),
    {LC1, D} = hide_calls(LC, MaxLine),
    case qlc:transform_from_evaluator(LC1, Bs0) of
        {ok,{call,L,Remote,[QLC]}} ->
            QLC1 = unhide_calls(QLC, MaxLine, D),
            expr({call,L,Remote,[QLC1 | As0]}, Bs0, Lf, Ef, RBs);
        {not_ok,Error} ->
            ret_expr(Error, Bs0, RBs)
    end;
expr({call,_,{remote,_,Mod,Func},As0}, Bs0, Lf, Ef, RBs) ->
    Mod1 = expand_module_name(Mod, Bs0),
    {value,M,Bs1} = expr(Mod1, Bs0, Lf, Ef, none),
    {value,F,Bs2} = expr(Func, Bs0, Lf, Ef, none),
    {As,Bs3} = expr_list(As0, merge_bindings(Bs1, Bs2), Lf, Ef),
    %% M could be a parameterized module (not an atom).
    case is_atom(M) andalso erl_internal:bif(M, F, length(As)) of
        true ->
            bif(F, As, Bs3, Ef, RBs);
        false ->
            do_apply({M,F}, As, Bs3, Ef, RBs)
    end;
expr({call,_,{atom,_,Func},As0}, Bs0, Lf, Ef, RBs) ->
    case erl_internal:bif(Func, length(As0)) of
        true ->
            {As,Bs} = expr_list(As0, Bs0, Lf, Ef),
            bif(Func, As, Bs, Ef, RBs);
        false ->
            local_func(Func, As0, Bs0, Lf, RBs)
    end;
expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun}
    {value,Func,Bs1} = expr(Func0, Bs0, Lf, Ef, none),
    {As,Bs2} = expr_list(As0, Bs1, Lf, Ef),
    do_apply(Func, As, Bs2, Ef, RBs);
expr({'catch',_,Expr}, Bs0, Lf, Ef, RBs) ->
    Ref = make_ref(),
    case catch {Ref,expr(Expr, Bs0, Lf, Ef, none)} of
	{Ref,{value,V,Bs}} ->	  % Nothing was thrown (guaranteed).
            ret_expr(V, Bs, RBs);
	Other ->
            ret_expr(Other, Bs0, RBs)
    end;
expr({match,_,Lhs,Rhs0}, Bs0, Lf, Ef, RBs) ->
    {value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf, Ef, none),
    case match(Lhs, Rhs, Bs1) of
	{match,Bs} ->
            ret_expr(Rhs, Bs, RBs);
	nomatch ->
	    erlang:raise(error, {badmatch,Rhs}, stacktrace())
    end;
expr({op,_,Op,A0}, Bs0, Lf, Ef, RBs) ->
    {value,A,Bs} = expr(A0, Bs0, Lf, Ef, none),
    eval_op(Op, A, Bs, Ef, RBs);
expr({op,_,'andalso',L0,R0}, Bs0, Lf, Ef, RBs) ->
    {value,L,Bs1} = expr(L0, Bs0, Lf, Ef, none),
    V = case L of
	    true ->
		{value,R,_} = expr(R0, Bs1, Lf, Ef, none),
		case R of
		    true -> true;
		    false -> false;
		    _ -> erlang:raise(error, {badarg,R}, stacktrace())
		end;
	    false -> false;
	    _ -> erlang:raise(error, {badarg,L}, stacktrace())
	end,
    ret_expr(V, Bs1, RBs);
expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) ->
    {value,L,Bs1} = expr(L0, Bs0, Lf, Ef, none),
    V = case L of
	    true -> true;
	    false ->
		{value,R,_} = expr(R0, Bs1, Lf, Ef, none),
		case R of
		    true -> true;
		    false -> false;
		    _ -> erlang:raise(error, {badarg,R}, stacktrace())
		end;
	    _ -> erlang:raise(error, {badarg,L}, stacktrace())
	end,
    ret_expr(V, Bs1, RBs);
expr({op,_,Op,L0,R0}, Bs0, Lf, Ef, RBs) ->
    {value,L,Bs1} = expr(L0, Bs0, Lf, Ef, none),
    {value,R,Bs2} = expr(R0, Bs0, Lf, Ef, none),
    eval_op(Op, L, R, merge_bindings(Bs1, Bs2), Ef, RBs);
expr({bin,_,Fs}, Bs0, Lf, Ef, RBs) ->
    EvalFun = fun(E, B) -> expr(E, B, Lf, Ef, none) end,
    case catch eval_bits:expr_grp(Fs, Bs0, EvalFun) of
	{value,V,Bs} -> 
	    ret_expr(V, Bs, RBs);
	{'EXIT',{Reason,_}} ->
	    erlang:raise(error, Reason, stacktrace())
    end;    
expr({remote,_,_,_}, _Bs, _Lf, _Ef, _RBs) ->
    erlang:raise(error, {badexpr,':'}, stacktrace());
expr({value,_,Val}, Bs, _Lf, _Ef, RBs) ->    % Special case straight values.
    ret_expr(Val, Bs, RBs).

find_maxline(LC) ->
    put('$erl_eval_max_line', 0),
    F = fun(L) ->
                case is_integer(L) and (L > get('$erl_eval_max_line')) of
                    true -> put('$erl_eval_max_line', L);
                    false -> ok
                end end,
    _ = erl_lint:modify_line(LC, F),
    erase('$erl_eval_max_line').

hide_calls(LC, MaxLine) ->
    LineId0 = MaxLine + 1,
    {NLC, _, D} = hide(LC, LineId0, dict:new()),
    {NLC, D}.

%% v/1 and local calls are hidden.
hide({value,L,V}, Id, D) ->
    {{atom,Id,ok}, Id+1, dict:store(Id, {value,L,V}, D)};
hide({call,L,{atom,_,N}=Atom,Args}, Id0, D0) ->
    {NArgs, Id, D} = hide(Args, Id0, D0),
    C = case erl_internal:bif(N, length(Args)) of
            true ->
                {call,L,Atom,NArgs};
            false -> 
                {call,Id,{remote,L,{atom,L,m},{atom,L,f}},NArgs}
        end,
    {C, Id+1, dict:store(Id, {call,Atom}, D)};
hide(T0, Id0, D0) when is_tuple(T0) -> 
    {L, Id, D} = hide(tuple_to_list(T0), Id0, D0),
    {list_to_tuple(L), Id, D};
hide([E0 | Es0], Id0, D0) -> 
    {E, Id1, D1} = hide(E0, Id0, D0),
    {Es, Id, D} = hide(Es0, Id1, D1),
    {[E | Es], Id, D};
hide(E, Id, D) -> 
    {E, Id, D}.