%% -*- erlang-indent-level: 2 -*-
%% $Id$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% ============================================================================
%%  Filename :  hipe_icode_ssa_const_prop.erl
%%  Authors  :  Daniel Luna, Erik Andersson
%%  Purpose  :  Perform sparse conditional constant propagation.
%%  Notes    :  Works on the control-flow graph.
%%
%%  History  : * 2003-03-05: Created.
%%             * 2003-08-11: Passed simple testsuite.
%%             * 2003-10-01: Passed compiler testsuite.
%% ============================================================================
%%
%% Exports: sparse_cond_const_propagate/1.
%%
%% ============================================================================
%%
%% TODO: 
%%
%% Take care of failures in call and replace operation with apropriate
%% failure.
%%
%% Handle ifs with non-binary operators
%%
%% We want multisets for easier (and faster) creation of env->ssa_edges
%% 
%% Maybe do things with begin_handler, begin_try if possible
%%
%% Propagation of constant arguments when some of the arguments are bottom
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

-module(hipe_icode_ssa_const_prop).
-export([sparse_cond_const_propagate/1]).

-include("../main/hipe.hrl").

-define(CONST_PROP_MSG(Str,L),ok).
%%-define(CONST_PROP_MSG(Str,L),io:format(Str,L)).

%%-define(DEBUG, 1).

%%-----------------------------------------------------------------------------
%% Include stuff shared between SCCP on Icode and RTL.
%% NOTE: Needs to appear after DEBUG is possibly defined.
%%-----------------------------------------------------------------------------

-define(CODE, hipe_icode).
-define(CFG,  hipe_icode_cfg).
-include("../ssa/hipe_ssa_const_prop.inc").

%%-----------------------------------------------------------------------------

visit_expression(Instruction, Environment) ->
  EvaluatedArguments =  [lookup_lattice_value(Argument, Environment) 
                         || Argument <- hipe_icode:args(Instruction)],
  case hipe_icode:type(Instruction) of
    move  ->
      visit_move_or_fmove     (Instruction, EvaluatedArguments, Environment);
    fmov  ->
      visit_move_or_fmove     (Instruction, EvaluatedArguments, Environment);
    'if' ->
      visit_if                (Instruction, EvaluatedArguments, Environment);
    goto ->
      visit_goto              (Instruction, EvaluatedArguments, Environment);
    type ->
      visit_type              (Instruction, EvaluatedArguments, Environment);
    call ->
      visit_call              (Instruction, EvaluatedArguments, Environment);
    switch_val ->
      visit_switch_val        (Instruction, EvaluatedArguments, Environment);
    switch_tuple_arity ->
      visit_switch_tuple_arity(Instruction, EvaluatedArguments, Environment);
    begin_handler ->
      visit_begin_handler     (Instruction, EvaluatedArguments, Environment);
    begin_try ->
      visit_begin_try        (Instruction, EvaluatedArguments, Environment);
    _ ->
      %% label, end_try, comment, return, fail
      {[], [], Environment}
  end.

%%-----------------------------------------------------------------------------

visit_begin_try(Instruction, [], Environment) ->
  Label     = hipe_icode:begin_try_label(Instruction), 
  Successor = hipe_icode:begin_try_successor(Instruction),
  {[Label, Successor], [], Environment}.

%%-----------------------------------------------------------------------------

visit_begin_handler(Instruction, _Arguments, Environment) ->
  Destinations = hipe_icode:begin_handler_dstlist(Instruction),
  {Environment1, SSAWork} =
    lists:foldl(fun (Dst, {Env0,Work0}) ->
		    {Env, Work} = update_lattice_value({Dst, bottom}, Env0),
		    {Env, Work ++ Work0}
		end,
		{Environment, []},
		Destinations),
  {[], SSAWork, Environment1}.

%%-----------------------------------------------------------------------------

visit_switch_val(Instruction, [Argument], Environment) ->
  Cases     = hipe_icode:switch_val_cases(Instruction),
  FailLabel = hipe_icode:switch_val_fail_label(Instruction),
  case Argument of
    bottom ->
      FlowWork  = [Label || {_Value, Label} <- Cases],
      FlowWork1 = [FailLabel | FlowWork],
      {FlowWork1, [], Environment};
    _ ->
      Target = get_switch_target(Cases, Argument, FailLabel),
      {[Target], [], Environment}
  end.

%%-----------------------------------------------------------------------------

visit_switch_tuple_arity(Instruction, [Argument], Environment) ->
  Cases     = hipe_icode:switch_tuple_arity_cases(Instruction),
  FailLabel = hipe_icode:switch_tuple_arity_fail_label(Instruction),
  case Argument of
    bottom ->
      FlowWork  = [Label || {_Value, Label} <- Cases],
      FlowWork1 = [FailLabel | FlowWork],
      {FlowWork1, [], Environment};
    Constant ->
      UnTagged = hipe_icode:const_value(Constant),
      case is_tuple(UnTagged) of
	true ->
	  Target = get_switch_target(Cases, size(UnTagged), FailLabel),
	  {[Target], [], Environment};
	false ->
	  {[FailLabel], [], Environment}
      end
  end.

%%-----------------------------------------------------------------------------

get_switch_target([], _Argument, FailLabel) ->
  FailLabel;

get_switch_target([{CaseValue, Target} | CaseList], Argument, FailLabel) ->
  case CaseValue == Argument of
    true ->
      Target;
    false ->
      get_switch_target(CaseList, Argument, FailLabel)
  end.

%%-----------------------------------------------------------------------------

visit_move_or_fmove(Instruction, [SourceValue], Environment) ->
  Destination = case hipe_icode:type(Instruction) of
		  move  -> hipe_icode:move_dst(Instruction);
		  fmove -> hipe_icode:fmove_dst(Instruction)
		end,
  {Environment1, SSAWork} = update_lattice_value({Destination, SourceValue},
						 Environment),
  {[], SSAWork, Environment1}.

%%-----------------------------------------------------------------------------

visit_if(Instruction, Arguments, Environment) ->
  case evaluate_if(hipe_icode:if_op(Instruction), Arguments) of
    true ->
      TrueLabel  = hipe_icode:if_true_label(Instruction),
      FlowWork   = [TrueLabel];
    false ->
      FalseLabel = hipe_icode:if_false_label(Instruction),
      FlowWork   = [FalseLabel];
    bottom ->
      TrueLabel  = hipe_icode:if_true_label(Instruction),
      FalseLabel = hipe_icode:if_false_label(Instruction),
      FlowWork   = [TrueLabel, FalseLabel]
  end,
  {FlowWork, [], Environment}.

%%-----------------------------------------------------------------------------

visit_goto(Instruction, _Arguments, Environment) ->
  GotoLabel = hipe_icode:goto_label(Instruction),
  FlowWork  = [GotoLabel],
  {FlowWork, [], Environment}.

%%-----------------------------------------------------------------------------

visit_type(Instruction, Values, Environment) ->
  case evaluate_type(hipe_icode:type_type(Instruction), Values) of
    true ->
      TrueLabel  = hipe_icode:type_true_label(Instruction),
      FlowWork   = [TrueLabel];
    false ->
      FalseLabel = hipe_icode:type_false_label(Instruction),
      FlowWork   = [FalseLabel];
    bottom ->
      TrueLabel  = hipe_icode:type_true_label(Instruction),
      FalseLabel = hipe_icode:type_false_label(Instruction),
      FlowWork   = [TrueLabel, FalseLabel]
  end,
  {FlowWork, [], Environment}.

%%-----------------------------------------------------------------------------

visit_call(Ins, Args, Environment) ->
  Dsts = hipe_icode:call_dstlist(Ins),
  Fun = hipe_icode:call_fun(Ins),
  Fail = call_fail_labels(Ins),
  Cont = call_continuation_labels(Ins),
  visit_call(Dsts, Args, Fun, Cont, Fail, Environment).

visit_call(Dst, Args, Fun, Cont, Fail, Environment) ->
  case lists:any(fun(X) -> (X == bottom) end, Args) of
    true ->
      FlowWork = Fail ++ Cont,
      {Environment1, SSAWork} =
	update_lattice_value({Dst, bottom}, Environment);
    false ->
      ConstArgs = [hipe_icode:const_value(Argument) || Argument <- Args],
      case catch evaluate_call_or_enter(ConstArgs, Fun) of
	{'EXIT', _} ->
	  FlowWork = Fail,
	  {Environment1, SSAWork} =
	    update_lattice_value({Dst, bottom}, Environment);
	bottom ->
	  FlowWork = Fail ++ Cont,
	  {Environment1, SSAWork} = 
	    update_lattice_value({Dst, bottom}, Environment);
	Constant ->
	  FlowWork = Cont,
	  {Environment1, SSAWork} =
	    update_lattice_value({Dst, Constant}, Environment)
      end
  end,
  {FlowWork, SSAWork, Environment1}.

%%-----------------------------------------------------------------------------

call_fail_labels(I)->
  case hipe_icode:call_fail_label(I) of
    [] -> [];
    Label -> [Label]
  end.

call_continuation_labels(I)->
  case hipe_icode:call_continuation(I) of
    [] -> [];
    Label -> [Label]
  end.
  
%%-----------------------------------------------------------------------------

%% Unary calls
evaluate_call_or_enter([Argument], Fun) ->
  case Fun of
    {erlang, hd, 1} ->
      hipe_icode:mk_const(hd(Argument));
    {erlang, tl, 1} ->
      hipe_icode:mk_const(tl(Argument));
    {unsafe_element, N} ->
      hipe_icode:mk_const(element(N, Argument));
    {erlang, atom_to_list, 1} ->
      hipe_icode:mk_const(atom_to_list(Argument));
    {erlang, list_to_atom, 1} ->
      hipe_icode:mk_const(list_to_atom(Argument));
    {erlang, tuple_to_list, 1} ->
      hipe_icode:mk_const(tuple_to_list(Argument));
    {erlang, list_to_tuple, 1} ->
      hipe_icode:mk_const(list_to_tuple(Argument));
    {erlang, length, 1} ->
      hipe_icode:mk_const(length(Argument));
    {erlang, size, 1} ->
      hipe_icode:mk_const(size(Argument));
    {erlang, abs, 1} ->
      hipe_icode:mk_const(abs(Argument));
    {erlang, round, 1} ->
      hipe_icode:mk_const(round(Argument));
    {erlang, trunc, 1} ->
      hipe_icode:mk_const(trunc(Argument));
    mktuple ->
      hipe_icode:mk_const(list_to_tuple([Argument]));
    unsafe_untag_float ->
      hipe_icode:mk_const(float(Argument));
    conv_to_float ->
      hipe_icode:mk_const(float(Argument));
    fnegate ->
      hipe_icode:mk_const(0.0 - Argument);
    'bnot' ->
      hipe_icode:mk_const(Argument);
    _ ->
      bottom
  end;

%% Binary calls
evaluate_call_or_enter([Argument1,Argument2], Fun) ->
  case Fun of
    '+' ->
      hipe_icode:mk_const(Argument1 + Argument2);
    '-' ->
      hipe_icode:mk_const(Argument1 - Argument2);
    '*' ->
      hipe_icode:mk_const(Argument1 * Argument2);
    '/' ->
      hipe_icode:mk_const(Argument1 / Argument2);
    {erlang, 'div', 2} ->
      hipe_icode:mk_const(Argument1 div Argument2);
    {erlang, 'rem', 2} ->
      hipe_icode:mk_const(Argument1 rem Argument2);
    'bsl' ->
      hipe_icode:mk_const(Argument1 bsl Argument2);
    'bsr' ->
      hipe_icode:mk_const(Argument1 bsl Argument2);
    'band' ->
      hipe_icode:mk_const(Argument1 band Argument2);
    'bor' ->
      hipe_icode:mk_const(Argument1 bor Argument2);
    'bxor' ->
      hipe_icode:mk_const(Argument1 bxor Argument2);
    fp_add ->
      hipe_icode:mk_const(float(Argument1 + Argument2));
    fp_sub ->
      hipe_icode:mk_const(float(Argument1 - Argument2));
    fp_mul ->
      hipe_icode:mk_const(float(Argument1 * Argument2));
    fp_div ->
      hipe_icode:mk_const(Argument1 / Argument2);
    cons ->
      hipe_icode:mk_const([Argument1 | Argument2]);
    {erlang,element,2} ->
      hipe_icode:mk_const(element(Argument1, Argument2));
    {erlang, '++', 2} ->
      hipe_icode:mk_const(Argument1 ++ Argument2);
    {erlang, '--', 2} ->
      hipe_icode:mk_const(Argument1 -- Argument2);
    {erlang, append_element, 2} ->
      hipe_icode:mk_const(erlang:append_element(Argument1, Argument2));
    {unsafe_update_element, N} ->
      hipe_icode:mk_const(setelement(N, Argument1, Argument2));
    mktuple -> 
      hipe_icode:mk_const(list_to_tuple([Argument1,Argument2]));
    _Other ->
      %% io:format("In ~w(~w,~w)~n", [_Other,Argument1,Argument2]),
      bottom
  end;

%% The rest of the calls
evaluate_call_or_enter(Arguments, Fun) ->
  case Fun of
    mktuple ->
      hipe_icode:mk_const(list_to_tuple(Arguments));
    {erlang, setelement, 3} ->
      [Argument1, Argument2, Argument3] = Arguments,
      hipe_icode:mk_const(setelement(Argument1, Argument2, Argument3));
    _ ->
      bottom
  end.

%%-----------------------------------------------------------------------------

evaluate_if(Conditional, [Argument1, Argument2]) -> 
  case ((Argument1 == bottom) or (Argument2 == bottom)) of
    true  -> bottom;
    false -> evaluate_if_const(Conditional, Argument1, Argument2)
  end;
evaluate_if(_Conditional, _Arguments) ->
  bottom.

%%-----------------------------------------------------------------------------

evaluate_if_const(Conditional, Argument1, Argument2) ->
  case Conditional of
    '=:=' -> Argument1 =:= Argument2;
    '=='  -> Argument1 ==  Argument2;
    '=/=' -> Argument1 =/= Argument2;
    '/='  -> Argument1  /= Argument2;
    '<'   -> Argument1  <  Argument2;
    '>='  -> Argument1  >= Argument2;
    '=<'  -> Argument1 =<  Argument2;
    '>'   -> Argument1  >  Argument2;
    _     -> bottom
  end.

%%-----------------------------------------------------------------------------

evaluate_type(Type, Vals) ->
  case [X||X<-Vals,X=:=bottom] of
    [] -> evaluate_type_const(Type, Vals);
    _ -> bottom
  end.

%%-----------------------------------------------------------------------------

evaluate_type_const(Type, [Arg|Left]) ->
  Test = 
    case {Type, hipe_icode:const_value(Arg)} of
      {nil,    []   }  -> true;
      {nil,    _    }  -> false;
      {cons,   [_|_]}  -> true;
      {cons,   _    }  -> false;
      {{tuple, N}, T} when is_tuple(T), size(T) == N -> true;
      {atom,       A} when is_atom(A) -> true;
      {{atom, A},  A} when is_atom(A) -> true;
      {{record, A, S}, R} when is_tuple(R), 
			       size(R) == S, 
			       element(1, R) =:= A -> true;
      {{record, _, _}, _} -> false;
      _                -> bottom
    end,
  case Test of
    bottom -> bottom;
    false -> false;
    true -> evaluate_type_const(Type, Left)
  end;
evaluate_type_const(_Type, []) ->
  true.

%%-----------------------------------------------------------------------------
%% Icode-specific code below
%%-----------------------------------------------------------------------------

update_instruction(Instruction, Environment) ->
  case hipe_icode:type(Instruction) of
    call ->
      update_call(Instruction, Environment);
    enter ->
      update_enter(Instruction, Environment);
    'if' ->
      update_if(Instruction, Environment);
    move ->
      update_move(Instruction, Environment);
    phi ->
     update_phi(Instruction, Environment);
    switch_val ->
      update_switch_val(Instruction, Environment);
    type ->
      update_type(Instruction, Environment);
    switch_tuple_arity ->
      update_switch_tuple_arity(Instruction, Environment);
    _ ->
      %% goto, comment, label, return, begin_handler, end_try,
      %% begin_try, fail
      %% We could but don't handle: catch?, fail?
      [Instruction]
  end.

%%-----------------------------------------------------------------------------

update_call(Instruction, Environment) ->
  DestList = hipe_icode:call_dstlist(Instruction),
  case DestList of
    [Destination] ->
      case lookup_lattice_value(Destination, Environment) of
	bottom ->
	  NewArguments = update_arguments(
			   hipe_icode:call_args(Instruction),
			   Environment),
	  [hipe_icode:call_args_update(Instruction, NewArguments)];
	X -> 
	  NewInstructions =
	    case is_call_to_fp_op(Instruction) of
	      true ->
		TmpIns = 
		  hipe_icode:call_fun_update(Instruction, unsafe_untag_float),
		[hipe_icode:call_args_update(TmpIns, [X])];
	      false ->
		case hipe_icode:call_continuation(Instruction) of
		  [] ->
		    [hipe_icode:mk_move(Destination, X)];
		  ContinuationLabel ->
		    [hipe_icode:mk_move(Destination, X),
		     hipe_icode:mk_goto(ContinuationLabel)]
		end
	    end,
	  ?CONST_PROP_MSG("call: ~w ---> ~w\n",
			  [Instruction, NewInstructions]),
	  NewInstructions
      end;
%%     %% [] ->  %% No destination; we don't touch this
%%     [] -> 
%%       NewArguments = update_arguments(hipe_icode:call_args(Instruction),
%%                                       Environment),
%%       [hipe_icode:call_args_update(Instruction, NewArguments)];
    %% List-> %% Means register allocation; not implemented at this point
    _ ->
      [Instruction]
  end.

%%-----------------------------------------------------------------------------

is_call_to_fp_op(Ins)->
  case hipe_icode:call_fun(Ins) of
    fp_add             -> true;
    fp_sub             -> true;
    fp_mul             -> true;
    fp_div             -> true;
    fnegate            -> true;
    conv_to_float      -> true;
    unsafe_untag_float -> true;
    _                  -> false
  end.

%%-----------------------------------------------------------------------------

update_enter(Ins, Env) ->
  Args = hipe_icode:enter_args(Ins),
  EvalArgs = [lookup_lattice_value(X, Env) || X<-Args],
  Fun = hipe_icode:enter_fun(Ins),
  case lists:any(fun(X) -> (X == bottom) end, EvalArgs) of
    true ->
      [Ins];
    false ->
      ConstVals = [hipe_icode:const_value(X)||X<-EvalArgs],
      case catch evaluate_call_or_enter(ConstVals, Fun) of
	{'EXIT', _} -> 
	  [Ins];
	bottom -> 
	  [Ins];
	Const ->
	  Dst = hipe_icode:mk_new_var(),
	  [hipe_icode:mk_move(Dst, Const),
	   hipe_icode:mk_return([Dst])]
      end
  end.
  
%%-----------------------------------------------------------------------------

update_if(Instruction, Environment) ->
  Args = hipe_icode:if_args(Instruction),
  EvaluatedArguments = [lookup_lattice_value(Argument, Environment) 
                        || Argument <- Args],
  Op = hipe_icode:if_op(Instruction),
  case evaluate_if(Op, EvaluatedArguments) of
    true ->
      TrueLabel  = hipe_icode:if_true_label(Instruction),
      ?CONST_PROP_MSG("ifT: ~w ---> goto ~w\n", [Instruction, TrueLabel]),
      [hipe_icode:mk_goto(TrueLabel)];
    false ->
      FalseLabel = hipe_icode:if_false_label(Instruction),
      ?CONST_PROP_MSG("ifF: ~w ---> goto ~w\n", [Instruction, FalseLabel]),
      [hipe_icode:mk_goto(FalseLabel)];
    bottom ->
      %% Convert the if-test to a type test if possible.
      Op = hipe_icode:if_op(Instruction),
      case Op == '=:=' orelse Op == '=/=' of
	false -> [Instruction];
	true ->
	  [Arg1, Arg2] = Args,
	  case EvaluatedArguments of
	    [bottom, bottom] -> 
	      [Instruction];
	    [bottom, X] -> 
	      conv_if_to_type(Instruction, hipe_icode:const_value(X), Arg1);
	    [X, bottom] ->
	      conv_if_to_type(Instruction, hipe_icode:const_value(X), Arg2)
	  end
      end
  end.

conv_if_to_type(I, Const, Arg) when is_atom(Const);
				    is_integer(Const);
				    Const == [] ->
  Test =
    if is_atom(Const) -> {atom, Const};
       is_integer(Const) -> {integer, Const};
       true -> nil
    end,
  {T, F} =
    case hipe_icode:if_op(I) of
      '=:=' -> {hipe_icode:if_true_label(I),hipe_icode:if_false_label(I)};
      '=/=' -> {hipe_icode:if_false_label(I),hipe_icode:if_true_label(I)}
    end,
  NewI = hipe_icode:mk_type([Arg], Test, T, F),
  ?CONST_PROP_MSG("if: ~w ---> type ~w\n", [I, NewI]),
  [NewI];
conv_if_to_type(I, _, _) ->
  [I].



%%-----------------------------------------------------------------------------

update_move(Instruction, Environment) ->
  Destination = hipe_icode:move_dst(Instruction),
  case lookup_lattice_value(Destination, Environment) of
    bottom ->
      [Instruction];
    X ->
      case hipe_icode:move_src(Instruction) of
	X ->
	  [Instruction];
	_ ->
	  ?CONST_PROP_MSG("move: ~w ---> ~w\n", [Instruction, X]),
	  [hipe_icode:move_src_update(Instruction, X)]
      end
      %% == [hipe_icode:mk_move(Destination, X)]
  end.

%%-----------------------------------------------------------------------------

update_phi(Instruction, Environment) ->
  Destination = hipe_icode:phi_dst(Instruction),
  case lookup_lattice_value(Destination, Environment) of
    bottom ->
      [Instruction];
    X ->
      ?CONST_PROP_MSG("phi: ~w ---> ~w\n", [Instruction, X]),
      [hipe_icode:mk_move(Destination, X)]
  end.

%%-----------------------------------------------------------------------------

update_type(Instruction, Environment) ->
  EvaluatedArguments = [lookup_lattice_value(Argument, Environment) || 
                         Argument <- hipe_icode:type_args(Instruction)],
  case evaluate_type(hipe_icode:type_type(Instruction), EvaluatedArguments) of
    true ->
      TrueLabel  = hipe_icode:type_true_label(Instruction),
      ?CONST_PROP_MSG("typeT: ~w ---> goto ~w\n", [Instruction, TrueLabel]),
      [hipe_icode:mk_goto(TrueLabel)];
    false ->
      FalseLabel = hipe_icode:type_false_label(Instruction),
      ?CONST_PROP_MSG("typeF: ~w ---> goto ~w\n", [Instruction, FalseLabel]),
      [hipe_icode:mk_goto(FalseLabel)];
    bottom ->
      [Instruction]
  end.

%%-----------------------------------------------------------------------------

update_switch_val(Instruction, Environment) ->
  Argument = hipe_icode:switch_val_arg(Instruction),
  Value    = lookup_lattice_value(Argument, Environment),
  case Value of
    bottom ->
      [Instruction];
    _ ->
      Cases     = hipe_icode:switch_val_cases(Instruction),
      FailLabel = hipe_icode:switch_val_fail_label(Instruction),
      Target    = get_switch_target(Cases, Value, FailLabel),
      ?CONST_PROP_MSG("sv: ~w ---> goto ~w\n", [Instruction, Target]),
      [hipe_icode:mk_goto(Target)]
  end.

%%-----------------------------------------------------------------------------

update_switch_tuple_arity(Instruction, Environment) ->
  Argument = hipe_icode:switch_tuple_arity_arg(Instruction),
  Value    = lookup_lattice_value(Argument, Environment),
  case Value of
    bottom ->
      [Instruction];
    Constant ->
      UnTagged = hipe_icode:const_value(Constant),
      case is_tuple(UnTagged) of
	true ->
	  Cases     = hipe_icode:switch_tuple_arity_cases(Instruction),
	  FailLabel = hipe_icode:switch_tuple_arity_fail_label(Instruction),
	  Target = get_switch_target(Cases, size(UnTagged), FailLabel),
	  ?CONST_PROP_MSG("sta: ~w ---> goto ~w\n", [Instruction, Target]),
	  [hipe_icode:mk_goto(Target)];
	false ->
	  [Instruction]
          %% TODO: Can the above be replaced with below??? Perhaps
	  %% together with some sort of "generate failure".
	  %% [hipe_icode:mk_goto(FailLabel)]
      end
  end.

%%-----------------------------------------------------------------------------

lookup_lattice_value(X, Environment) ->
  LatticeValues = env__lattice_values(Environment),
  case hipe_icode:is_const(X) of
    true ->
      X;
    false ->
      case gb_trees:lookup(X, LatticeValues) of
	none ->
	  ?WARNING_MSG("Earlier compiler steps generated erroneous " 
		       "code for X = ~w. We are ignoring this.\n",[X]),
	  bottom;
	{value, top} ->
	  ?EXIT({"lookup_lattice_value, top", X});
	{value, Y} ->
	  Y
      end
  end.

%%-----------------------------------------------------------------------------

update_arguments(ArgumentList, Environment) ->
  [case lookup_lattice_value(X, Environment) of
     bottom ->
       X;
     Constant ->
       Constant
   end || X <- ArgumentList].

%%----------------------------- End of file -----------------------------------
