------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 199x by International Computer Science Institute            --
-- This file is part of the GNU Sather package. It is free software; you may --
-- redistribute  and/or modify it under the terms of the  GNU General Public --
-- License (GPL)  as  published  by the  Free  Software  Foundation;  either --
-- version 2 of the license, or (at your option) any later version.          --
-- This  program  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- this class is included in optimize.sa and cannot be
-- used stand alone
class OPT_ITER is
   include OPT_HELPER;

   private opt_inlined_iter(func:AM_ROUT_DEF,n:AM_STMT_EXPR,c:AM_CURSOR,
	 it:AM_ITER_CALL_EXPR,need_safe_attr:BOOL,in_conditional:BOOL) is
      -- This function tries to move iter initialization
      -- out of the loop
      --
      -- we search for the first if statement of the form
      --         if some_bool_local
      -- we search for all other   if some_bool_local statements
      -- some_bool_local must be a loop constant.
      -- The last if statement must have an assignment of the
      -- form some_bool_local:=false
      -- currently we check only AM_ASSIGN_STMT. AM_PRE, AM_POST and AM_ASSERT_STMT
      -- are deleted.

      -- we begin by inlining all functions if possible.
      -- (this has to be done here, as the code where this
      -- iter initializations may be moved to has already been checked
      -- for functions to be inlined. Therefor the iter code that is moved
      -- will never again be checked for such functions.
      cc::=#AM_CURSOR(prog,n.stmts);
      loop
         am::=cc.next!;         
	 typecase am when AM_ROUT_CALL_EXPR then
	    dummy::=inline_func(func,am,cc);
	 else end;
      end;

      am::=n.stmts;
      lbool:AM_LOCAL_EXPR:=void;
      move_lbool::=true;

      -- search the bool local
      loop
         while!(~void(am) and void(lbool));
	 typecase am when AM_IF_STMT then
	    ifx::=am.test;
	    typecase ifx when AM_LOCAL_EXPR then
	       lbool:=ifx;
	    else end;
	 else end;
      end;
      if void(lbool) then 
         if prog.opt_debug then
	    #OUT+"could not move out statements, as I did not find the bool local\n";
	 end;
	 return;
      end;
      if ~c.is_const_in_loop(lbool) then 
         if prog.opt_debug then
	    #OUT+"sorry, but the local bool var is not a loop const: ";
	    AM_OUT::AM_out(lbool);#OUT+"\n";
	 end;
	 return;
      end;
      if c.loop_stmt.firsts.index_of(lbool)<0 then
         if prog.opt_debug then
	    #OUT+"the local bool constant I found will not be initialized to true at the beginning of the loop\n";
	 end;
	 return;
      end;
       
      -- find the first and only ASSIGN_STMT for lbool
      -- check that there are no more.
      c1::=#AM_CURSOR(prog,n.stmts);
      c1.ignore_pre:=true;
      c1.ignore_post:=true;
      c1.ignore_assert:=true;
      found_it::=false;
      ignore_next_reference::=true;
      loop
         d::=c1.next!;
	 typecase d when AM_ASSIGN_STMT then
	    dst::=d.dest;
	    typecase dst when AM_LOCAL_EXPR then
	       if dst=lbool then
	          if found_it then
		     if prog.opt_debug then
		        #OUT+"found two assignments to the bool local :-(\n";
		     end;
		     return;
		  else
		     found_it:=true;

		     -- there is just one reference to the local var left,
		     -- namely the one in this assign stmt.
		     ignore_next_reference:=true;

		     -- the assignment must be within an if stmt, so its
		     -- indent must be 1
		     if c1.indent/=1 then
		        if prog.opt_debug then
			   #OUT+"indent="+c1.indent+", so assignment is not at the first level of an if stmt.\n";
			end;
			return ;
		     end;
		     s::=c1.get_surr_stmt;
		     typecase s when AM_IF_STMT then
		        t::=s.test;
			typecase t when AM_LOCAL_EXPR then
			   if t/=lbool then
			      if prog.opt_debug then
			         #OUT+"wrong test local expr in if stmt.\n";
			      end;
			      return;
			   end;
			else
			   if prog.opt_debug then
			      #OUT+"wrong test clause in if stmt.\n";
			   end;
			   return;
			end;
			tr::=s.if_true;
			loop 
			   while!(~void(tr));
			   if SYS::id(tr)=SYS::id(d) then break!; end;
			   tr:=tr.next;
			end;
			if void(tr) then
			   if prog.opt_debug then 
			      #OUT+"Assignment is not in the true clause of the if stmt\n";
			   end;
		        end;
			src::=d.src;
			typecase src when AM_BOOL_CONST then
			   if src.val/=false then
			      if prog.opt_debug then
			         #OUT+"Assignment is :=true instead of :=false\n";
			      end;
			      return;
			   end;
			else
			   if prog.opt_debug then
			      #OUT+"Assignment is not :=true\n";
			   end;
			   return;
			end;
		     else
			if prog.opt_debug then
			   #OUT+"assignment is not within an if stmt\n";
			end;
			return;
		     end;
		  end;
	       end;
            else end;
	 when AM_LOCAL_EXPR then
	    if found_it then -- check that lbool is not used after the
	    		     -- assignment lbool:=false;
	       if ignore_next_reference then
	          ignore_next_reference:=false;
	       else
		  if d=lbool then
		     if prog.opt_debug then
			#OUT+"there is a reference to lbool after lbool:=false;\n";
		     end;
		     return;
		  end;
	       end;
	    end;
	 else end;
      end;
      -- When we get here, we know the correct bool local, and
      -- can proceed to move the statments out of the if
      if prog.opt_debug then
         #OUT+"it seems that we can move out some statements\n";
      end;
      comment::=#AM_COMMENT_STMT(it.source);
      comment.comment:="Initialization of inlined iter "+it.fun.str;
      c.insert_in_loop_init(comment);
      pr:$AM_STMT:=void;
      am:=n.stmts;
      inlined::=#AM_CURSOR(prog,n.stmts);
      inlined.ignore_pre:=true;
      inlined.ignore_post:=true;
      inlined.ignore_assert:=true;
      inlined.init_next;inlined.next;
      loop
         while!(~void(am));
	 typecase am 
	 when AM_IF_STMT then
	    l::=am.test;
	    typecase l when AM_LOCAL_EXPR then
	       if l=lbool then
	          pr:=void;
		  if ~void(am.if_false) then move_lbool:=false; end;
		  ifs::=am.if_true;
		  inlined.next; -- moves to bool local
		  inlined.next; -- moves to first statement
	    	  loop
		     while!(~void(ifs));
		     nifs::=ifs.next;
		     p::=ifs;
		     do_move::=false;
		     ignore_stmt::=false;
		     delete_it::=false;
		     if SYS::id(ifs)/=SYS::id(inlined.cur) then
		        #OUT+"inlined and ifs disagree about the current statement\n";
			#OUT+"ifs says:\n";
			AM_OUT::AM_out(ifs);
			#OUT+"and inlined is at:\n";
			AM_OUT::AM_out(inlined.cur);
			UNIX::exit(-1);
		     end;
	    	     typecase ifs 
		     when AM_ASSIGN_STMT then
			if (~need_safe_attr or ~prog.void_checks or ~has_attr_expr(ifs))
			   and hoistable_init_dest(ifs.dest,c,need_safe_attr,in_conditional)
			   and hoistable_init(ifs.src,c,need_safe_attr,in_conditional) 
			   and inlined.is_not_used_in_func_before_eval_cur_expr(ifs.dest)
			   and inlined.is_const_in_func_before_eval_cur_expr(ifs.src)
			   then
			   adest::=ifs.dest;
			   typecase adest when AM_LOCAL_EXPR then
			      do_move:=true;
			   else 
			      if ~need_safe_attr then
				 do_move:=true;
			      end;
			   end;
			   if need_safe_attr and do_move then
			      make_safe_attr(ifs);
			   end;
			else
			   adest::=ifs.dest;
			   typecase adest when AM_LOCAL_EXPR then
			      if adest=lbool then
				 ignore_stmt:=true;
			      end;
			   else end;
			   if prog.opt_debug then
			      if ~hoistable_init_dest(ifs.dest,c,need_safe_attr,in_conditional) then
			         #OUT+"cannot move assign stmt, as it has no hoistable destination\n";
			      end;
			      if ~hoistable_init(ifs.src,c,need_safe_attr,in_conditional)  then
			         #OUT+"cannot move assign stmt, as it has no hoistable source\n";
			      end;
			      if ~inlined.is_not_used_in_func_before_eval_cur_expr(ifs.dest) then
			         #OUT+"cannot move assign stmt, as dest is used in inlined iter\n";
			      end;   
			      if ~inlined.is_const_in_func_before_eval_cur_expr(ifs.src) then
			         #OUT+"cannot move assign stmt, as source is not const in inlined iter\n";
			      end;
			   end;
			end;
		     when AM_PRE_STMT then 
		        if ~prog.pre_checks then delete_it:=true; end;
		     when AM_POST_STMT then 
		        if ~prog.post_checks then delete_it:=true; end;
		     when AM_ASSERT_STMT then 
		        if ~prog.assert_checks then delete_it:=true; end;
		     else end; -- typecase
		     if do_move then
			if void(pr) then
			   am.if_true:=ifs.next;
			else 
			   pr.next:=ifs.next;
			end;
			nifs:=ifs.next;
			p:=pr;
			ifs.next:=void;
			c.insert_in_loop_init(ifs);
			if prog.opt_debug then
			   #OUT+"moving the assign stmt to the beginning of the loop:\n";
			   AM_OUT::AM_one_stmt(ifs);
			end;
			-- well, we removed the current stmt of inlined, so we have 
			-- to trick it a bit and set it to the correct stmt. There is
			-- just one problem, namely if the next statment is void. in
			-- this case we "invent" a new statment;
			if void(nifs) then
			   inlined.cur:=#AM_COMMENT_STMT(void);
			else
			   inlined.cur:=nifs;
		        end;
		     elsif delete_it then
			if void(pr) then
			   am.if_true:=ifs.next;
			else 
			   pr.next:=ifs.next;
			end;
			nifs:=ifs.next;
			p:=pr;
			ifs.next:=void;
			-- well, we removed the current stmt of inlined, so we have 
			-- to trick it a bit and set it to the correct stmt. There is
			-- just one problem, namely if the next statment is void. in
			-- this case we "invent" a new statment;
			if void(nifs) then
			   inlined.cur:=#AM_COMMENT_STMT(void);
			else
			   inlined.cur:=nifs;
		        end;
		     elsif ~ignore_stmt then 
			move_lbool:=false;
		     end;
		     pr:=p;
		     ifs:=nifs;
		     -- if void(ifs) then we move inlined 5 statements below,
		     -- and if do_move, we already moved it 10 statements above.
		     if ~void(ifs) and ~do_move and ~delete_it then inlined.next_stmt; end;
                  end; -- loop
		  -- we must be careful to move the inlined cursor over the if_false
		  -- part of the if statement.
		  inlined.surr_stmt;
		  inlined.after_if;
	       end; -- if l=lbool
	    else end; -- AM_LOCAL_EXPR
	 else end; -- AM_IF_STMT
         am:=am.next;
	 inlined.next_stmt;
      end; -- loop

      -- now we have to delete all empty if statements.
      -- if move_lbool is true, we can delete them without 
      -- checking, otherwise we must make sure that if_true and
      -- if_false are both void.
      pr:=void;
      am:=n.stmts;
      loop
         while!(~void(am));
	 amm::=am;
	 typecase amm 
	 when AM_IF_STMT then
	    l::=amm.test;
	    typecase l when AM_LOCAL_EXPR then
	       if l=lbool then
	          if move_lbool or (void(amm.if_true) and void(amm.if_false)) then
		     prog.stat.incr("O: # if stmts removed");
		     if void(pr) then
		        n.stmts:=am.next;
			am:=n.stmts;
		     else
		        pr.next:=am.next;
			am:=am.next;
		     end;
		  else
		     pr:=am; am:=am.next;
   		  end;
	       else
		  pr:=am; am:=am.next;
	       end;
	    else 
	       pr:=am; am:=am.next;
	    end;
	 else 
	    pr:=am; am:=am.next;
	 end;
      end; -- loop
      -- Well, that's it.
   end;

   private inline_iter(func:AM_ROUT_DEF,am:AM_ITER_CALL_EXPR,c:AM_CURSOR,
        do_optimization:BOOL,need_safe_attr:BOOL,in_conditional:BOOL):BOOL is
      if ~prog.inline_iters then return false; end;
      ok::=false;
      if prog.opt_debug then 
	 #OUT+"Trying to inline the iter call "+am.fun.str+":";
      end;
      n::=prog.inliner.general_inline(func,c.loop_stmt,am);
      if ~SYS::ob_eq(n,am) then
	 prog.stat.incr("O: # of iter calls inlined");
	 if prog.opt_debug then 
	    #OUT+"done\n";
	 end;

	 if prog.hoist_iter_init and do_optimization then 
	    typecase n when AM_STMT_EXPR then
	       -- we have to remove the iter, as otherwise 
	       -- side effects from it may interfere with 
	       -- the optimization below. We replace it with a dummy
	       -- is_void_expr, which is removed later (a noop 
	       -- expr would be better, of course).
	       if prog.opt_debug then
		  #OUT+"iter code before optimization:\n";
		  AM_OUT::AM_out(n);
		  #OUT+"\n";
	       end;
	       c.replace_expr(#AM_IS_VOID_EXPR(void)); 
	       opt_inlined_iter(func,n,c,am,need_safe_attr,in_conditional);
	       if prog.opt_debug then
		  #OUT+"iter code after optimization:\n";
		  AM_OUT::AM_out(n);
		  #OUT+"\n";
	       end;
	    else end; -- we only consider standard inlined iters
	 end;
	 c.replace_expr(n); -- insert the optimized version.
	 ok:=true;
      else
	 if prog.opt_debug then
	    #OUT+"no way\n";
	 end;
      end;
      return ok;
   end;

   work_on_iter(func:AM_ROUT_DEF,am:AM_ITER_CALL_EXPR,c:AM_CURSOR,after_loop_break:ARRAY{BOOL})
   is
      stmt::=am.init;
      do_optimize::=~func.is_iter and c.not_in_a_case_in_a_loop;
      need_safe_attr::=false;
      has_attr::=false;
      in_conditional::= ~c.not_in_a_conditional_in_loop;
      -- if ~in_conditional the iter can use the loop index
      am.use_loop_index:=~in_conditional and am.fun.is_builtin and am.fun.builtin_info.use_index;
      if am.use_loop_index then prog.stat.incr("O: iters using a loop index variable"); end;
      if am.use_loop_index and void(am.lp.loop_index_var) then
	 prog.stat.incr("O: loops having a loop index variable");
	 am.lp.loop_index_var:=new_local(func,tp_int);
	 as::=#AM_ASSIGN_STMT(am.lp.source);
	 as.dest:=am.lp.loop_index_var;
	 as.src:=zero;
	 comment::=#AM_COMMENT_STMT(am.source);
	 comment.comment:="loop index variable";
	 c.insert_in_loop_init(comment);
	 c.insert_in_loop_init(as);

	 p::=#AM_ASSIGN_STMT(am.lp.source);
	 p.dest:=am.lp.loop_index_var;
	 mi::=#AM_ROUT_CALL_EXPR(2,am.lp.source);
	 func.calls:=func.calls.push(mi);
	 mi[0]:=#(p.dest);
	 mi[1]:=#(one);
	 args::=#ARRAY{ARG}(1);
	 args[0]:=#(tp_int);
	 mi.fun:=#SIG(tp_int, #ARRAY{$TP}(0),
	  IDENT_BUILTIN::plus_ident, args, tp_int, true);
	 prog.generate_am.output_sig(mi.fun);
	 p.src:=mi;
	 c.append_to_loop(p);
      end;
      -- check if we can safely move the initialization of the current iter
      -- to the beginning of the loop. This assumes that all assignments in the
      -- ini field of the iter are to local variables which are only used during
      -- the call of the iter and never somewhere else in the loop.
      loop while!(~void(stmt) and do_optimize);
	 typecase stmt when AM_ASSIGN_STMT then
	    if ~c.is_const(stmt.src) then
	       need_safe_attr:=after_loop_break[c.loops] or in_conditional;
	       do_optimize:=hoistable_init(stmt.src,c,need_safe_attr,in_conditional);
	       has_attr:=has_attr_expr(stmt.src);
	       if ~do_optimize and prog.opt_debug then
		  #OUT+"the following expression is not hoistable: (need_safe_attr="+need_safe_attr+" in_cond="+in_conditional+")\n";
		  AM_OUT::AM_out(stmt.src);
		  #OUT+"\n";
	       end;
	    end;
	 else 
	    if prog.opt_debug then
	       #OUT+"ignoring iter "+am.fun.str+" because its init_stmt has not only AM_ASSIGN_STMT\n";
	    end;
	    do_optimize:=false; 
	 end; 
	 stmt:=stmt.next;
      end;
      if do_optimize and need_safe_attr and has_attr and prog.void_checks then
	 do_optimize:=false;
      end;
      if do_optimize then
	 if ~inline_iter(func,am,c,true,need_safe_attr,in_conditional) then
	       prog.stat.incr("O: # of iters not inlined");
	       if prog.opt_verbose and ~am.fun.is_builtin then
		  #OUT+am.source.str+": INFO: iter "+am.fun.str+" ignored by inliner.\n";
	       end;
	       if prog.hoist_iter_init then
		  if need_safe_attr then make_safe_attr(am.init); end;
		  move_init_stmts(func,am,c);
	       end;
	 end;
      else
	 if prog.opt_verbose and ~am.fun.is_builtin then
	    #OUT+am.source.str+": INFO: iter "+am.fun.str+" ignored by optimizer.\n";
	 end;
	 if ~inline_iter(func,am,c,false,false,in_conditional) then
	    if prog.opt_verbose and ~am.fun.is_builtin then
	       #OUT+am.source.str+": INFO: iter "+am.fun.str+" ignored by inliner.\n";
	    end;
	    prog.stat.incr("O: # of iters not optimized and not inlined");
--		     if prog.opt_debug then
--			#OUT+"do_optimize="+do_optimize+"  in_conditional="+in_conditional+"\n";
--			#OUT+"code: ";
--			AM_OUT::AM_out(am,0,5);
--			#OUT+"\n";
--		     end;
	 end;
	 prog.stat.incr("O: # of iters not optimized");
      end;
   end;
end;
