/*

  $Id$

  Copyright 1989-2016 MINES ParisTech

  This file is part of PIPS.

  PIPS is free software: you can redistribute it and/or modify it
  under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  any later version.

  PIPS 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 the GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with PIPS.  If not, see <http://www.gnu.org/licenses/>.

*/
#ifdef HAVE_CONFIG_H
    #include "pips_config.h"
#endif
/* HPFC - Fabien Coelho, May 1993 and later...
 *
 * Compiler
 *
 * stat is the current statement to be compiled, and there are
 * pointers to the current statement building of the node and host
 * codes. the module of these are also kept in order to add
 * the needed declarations generated by the compilation.
 *
 * however, every entities of the compiled program, and of
 * both generated programs will be mixed, due to the
 * tabulated nature of these objects. 
 * some objects will be shared.
 * I don't think this is a problem.
 */

#include "defines-local.h"

/* global variables
 */
entity host_module, node_module;

#define debug_print_control(c, w)\
  fprintf(stderr, \
	  "%s: ctr %p (stat %p) , %zd preds, %zd succs\n", w, \
          c, control_statement(c), \
	  gen_length(control_predecessors(c)), \
	  gen_length(control_successors(c))); \
  print_statement(control_statement(c));

static void 
hpf_compile_block(stat, hoststatp, nodestatp)
statement stat;
statement *hoststatp,*nodestatp;
{
    list /* of statements */ lhost=NIL, lnode=NIL;
    statement hostcd, nodecd;

    pips_assert("block", instruction_block_p(statement_instruction(stat)));

    (*hoststatp) = MakeStatementLike(stat, is_instruction_block);
    (*nodestatp) = MakeStatementLike(stat, is_instruction_block);

    MAP(STATEMENT, s,
     {
	 hpf_compiler(s,&hostcd,&nodecd);
	 
	 lhost = CONS(STATEMENT, hostcd, lhost);
	 lnode = CONS(STATEMENT, nodecd, lnode);
     },
	 instruction_block(statement_instruction(stat)));

    instruction_block(statement_instruction(*hoststatp)) = gen_nreverse(lhost);
    instruction_block(statement_instruction(*nodestatp)) = gen_nreverse(lnode);

    DEBUG_STAT(9, entity_name(host_module), *hoststatp);
    DEBUG_STAT(9, entity_name(node_module), *nodestatp);
}

static void 
hpf_compile_test(s, hoststatp, nodestatp)
statement s;
statement *hoststatp,*nodestatp;
{
    statement
	s_true,	s_hosttrue, s_nodetrue,
	s_false, s_hostfalse, s_nodefalse;
    test the_test;
    expression condition;
    
    pips_assert("test", instruction_test_p(statement_instruction(s)));

    the_test = instruction_test(statement_instruction(s));
    condition = test_condition(the_test);
    
    (*hoststatp) = MakeStatementLike(s, is_instruction_test);
    (*nodestatp) = MakeStatementLike(s, is_instruction_test);

    /* if it may happen that a condition modifies the value
     * of a distributed variable, this condition is to be
     * put out of the statement, for separate compilation.
     */

    s_true = test_true(the_test);
    s_false = test_false(the_test);

    hpf_compiler(s_true, &s_hosttrue, &s_nodetrue);
    hpf_compiler(s_false, &s_hostfalse, &s_nodefalse);

    instruction_test(statement_instruction(*hoststatp)) =
	make_test(UpdateExpressionForModule(host_module, condition),
		  s_hosttrue,
		  s_hostfalse);

    instruction_test(statement_instruction(*nodestatp))=
	make_test(UpdateExpressionForModule(node_module, condition),
		  s_nodetrue,
		  s_nodefalse);

    DEBUG_STAT(9, entity_name(host_module), *hoststatp);
    DEBUG_STAT(9, entity_name(node_module), *nodestatp);
}

/* return the list of bounds
 */
static list /* of expression */
caller_list_of_bounds(
    _UNUSED_ entity fun,
    list /* of expression */ le)
{
    list /* of expression */ lneeded = NIL;
    int len = gen_length(le);

    for (; len>=1; len--)
    {
	expression e = EXPRESSION(gen_nth(len-1, le));
	syntax s = expression_syntax(e);

	if (syntax_reference_p(s)) 
	{
	    entity var, old;

	    old = reference_variable(syntax_reference(s));
	    var = load_new_node(old);
	    pips_debug(8, "considering %s\n", entity_name(var));

	    if (array_distributed_p(old))
	    {
		int dim = NumberOfDimension(var);

		for (; dim>=1; dim--)
		{
		    if (ith_dim_overlapable_p(old, dim))
		    {
			lneeded = 
			    CONS(EXPRESSION, hpfc_array_bound(var, false, dim),
			    CONS(EXPRESSION, hpfc_array_bound(var, true, dim),
				 lneeded));
		    }
		}
	    }
	}
    }

    return lneeded;
}

static void 
hpf_compile_call(
    statement stat,       /* compiled statement */
    statement *hoststatp, /* returned host version */
    statement *nodestatp) /* returned node version */
{
    call c = instruction_call(statement_instruction(stat));

    /* IO functions should be detected earlier, in hpf_compiler
     */
    pips_assert("not an io call", !IO_CALL_P(c));
    pips_assert("call", instruction_call_p(statement_instruction(stat)));
    pips_debug(7, "function %s\n", entity_name(call_function(c)));

    DEBUG_STAT(9, "statement", stat);

    /* "kill" FC directive.
     * tells that the array is dead, hence all copies are live...
     */
    if (dead_fcd_directive_p(call_function(c)))
    {
	list /* of statement */ ls = NIL;

	MAP(EXPRESSION, e,
	{
	    entity primary = expression_to_entity(e);
	    pips_debug(5, "dealing with array %s\n", entity_name(primary));
	    if (array_distributed_p(primary))
		ls = CONS(STATEMENT, generate_all_liveness(primary, true), ls);
	},
	    call_arguments(c));
	
	(*hoststatp) = MakeStatementLike(stat, is_instruction_block);
	(*nodestatp) = MakeStatementLike(stat, is_instruction_block);
	
	instruction_block(statement_instruction(*hoststatp)) = NIL;
	instruction_block(statement_instruction(*nodestatp)) = ls;

	return;
    }

    /* no reference to distributed arrays...
     * the call is just translated into local objects.
     */
    if (!ref_to_dist_array_p(c))
    {
	pips_debug(7, "no reference to distributed variable\n");

	(*hoststatp)=MakeStatementLike(stat, is_instruction_call);
	(*nodestatp)=MakeStatementLike(stat, is_instruction_call);
	
	instruction_call(statement_instruction((*hoststatp))) = copy_call(c);
	update_object_for_module(*hoststatp, host_module);

	instruction_call(statement_instruction((*nodestatp))) = copy_call(c);
	update_object_for_module(*nodestatp, node_module);

	DEBUG_STAT(8, entity_name(host_module), *hoststatp);
	DEBUG_STAT(8, entity_name(node_module), *nodestatp);

	return;
    }

    /* should consider read and written variables
     */    
    if (ENTITY_ASSIGN_P(call_function(c)))
    {
	list /* of expressions */
	    lh = NIL, ln = NIL, args = call_arguments(c) ;
	expression 
	    w = EXPRESSION(CAR(args)),
	    r = EXPRESSION(CAR(CDR(args)));

	pips_assert("reference", syntax_reference_p(expression_syntax(w)));

	if (array_distributed_p
	    (reference_variable(syntax_reference(expression_syntax(w)))))
	{
	    pips_debug(8, "c1-alpha\n");
	    
	    generate_c1_alpha(stat, &lh, &ln); /* C1-ALPHA */
	}
	else
	{
	    syntax s = expression_syntax(r);

	    /* reductions are detected here. They are not handled otherwise
	     */
	    if (syntax_call_p(s) && call_reduction_p(syntax_call(s)))
	    {
		statement sh, sn;

		if (!compile_reduction(stat, &sh, &sn))
		    pips_internal_error("reduction compilation failed");

		lh = CONS(STATEMENT, sh, NIL);
		ln = CONS(STATEMENT, sn, NIL);
	    }
	    else
	    {
		pips_debug(8, "c1-beta\n");
		
		generate_c1_beta(stat, &lh, &ln); /* C1-BETA */
	    }
	}

	(*hoststatp) = MakeStatementLike(stat, is_instruction_block);
	(*nodestatp) = MakeStatementLike(stat, is_instruction_block);
	
	instruction_block(statement_instruction(*hoststatp)) = lh;
	instruction_block(statement_instruction(*nodestatp)) = ln;
	
	DEBUG_STAT(8, entity_name(host_module), *hoststatp);
	DEBUG_STAT(8, entity_name(node_module), *nodestatp);

	return;
    }

    /* call to something with distributed variables, which is not an
     * assignment. Since I do not use the effects as I should, nothing is
     * done...
     */

    /* temporary (?:-) hack 
     */
    {
	entity fun = call_function(c);
	list /* of expressions */
            args = call_arguments(c),
	    leh=lUpdateExpr_but_distributed(host_module, args),
	    len=lUpdateExpr(node_module, args);
	
	update_overlaps_in_caller(fun, args);

	pips_debug(7, "some references to distributed variable\n");

	(*hoststatp)=MakeStatementLike(stat, is_instruction_call);
	(*nodestatp)=MakeStatementLike(stat, is_instruction_call);
	
	instruction_call(statement_instruction((*hoststatp)))=
	    make_call(fun, leh);

	instruction_call(statement_instruction((*nodestatp)))=
	    make_call(fun, gen_nconc(len, caller_list_of_bounds(fun, args)));

	DEBUG_STAT(8, entity_name(host_module), *hoststatp);
	DEBUG_STAT(8, entity_name(node_module), *nodestatp);

	return;
    }
}

static void compile_control(
    control c,
    statement_mapping maph,
    statement_mapping mapn)
{
    control hostc, nodec;
    statement stath, statn, statc = control_statement(c);
    
    hpf_compiler(statc, &stath, &statn);
    
    DEBUG_STAT(7, "statc", statc);
    DEBUG_STAT(7, "host stat", stath);
    DEBUG_STAT(7, "node stat", statn);
    
    hostc = make_control(stath, NIL, NIL);
    SET_CONTROL_MAPPING(maph, c, hostc);
    
    nodec = make_control(statn, NIL, NIL);
    SET_CONTROL_MAPPING(mapn, c, nodec);
}

static void 
hpf_compile_unstructured(
    statement stat,
    statement *hoststatp,
    statement *nodestatp)
{
    instruction inst=statement_instruction(stat);

    pips_assert("unstructured", instruction_unstructured_p(inst));

    if (one_statement_unstructured(instruction_unstructured(inst)))
    {
	pips_debug(7, "one statement recognize\n");

	/* nothing spacial is done! 
	 * ??? there may be a problem with the label of the statement, if any.
	 */
	hpf_compiler(control_statement
	     (unstructured_control(instruction_unstructured(inst))),
	     hoststatp, nodestatp);
    }
    else
    {
	control_mapping 
	    hostmap = MAKE_CONTROL_MAPPING(),
	    nodemap = MAKE_CONTROL_MAPPING();
	unstructured  u = instruction_unstructured(inst);
	control ct = unstructured_control(u),
	        ce = unstructured_exit(u), new_ct, new_ce;
	list blocks = NIL;

	pips_debug(6, "beginning\n");

	CONTROL_MAP(c, compile_control(c, hostmap, nodemap), ct, blocks);

	if (!gen_in_list_p(ce, blocks))
	{
	    pips_debug(5, "exit not in blocks\n");
	    blocks = CONS(CONTROL, ce, blocks);
	    compile_control(ce, hostmap, nodemap);
	}
	
	MAP(CONTROL, c,
	 {
	     update_control_lists(c, hostmap);
	     update_control_lists(c, nodemap);
	 },
	    blocks);

	ifdebug(9)
	{
	    control h_tmp, n_tmp;

	    pips_debug(9, "controls:\n");
	    
	    MAP(CONTROL, c_tmp,
	     {
		 h_tmp = (control) GET_CONTROL_MAPPING(hostmap, c_tmp);
		 n_tmp = (control) GET_CONTROL_MAPPING(nodemap, c_tmp);
		 
		 debug_print_control(c_tmp, "initial");
		 debug_print_control(h_tmp, "host");
		 debug_print_control(n_tmp, "node");
	     },
		 blocks);
	}

	/*    HOST statement
	 */
	(*hoststatp) = MakeStatementLike(stat, is_instruction_unstructured);

	new_ct = (control) GET_CONTROL_MAPPING(hostmap, ct);
	new_ce = (control) GET_CONTROL_MAPPING(hostmap, ce);

	pips_assert("defined control", !control_undefined_p(new_ct) &&
		    !control_undefined_p(new_ce));

	ifdebug(9)
	{
	    pips_debug(9, "host controls for [%p,%p]:\n", ct, ce);
	    
	    debug_print_control(new_ct, "main");
	    debug_print_control(new_ce, "exit");
	}

	instruction_unstructured(statement_instruction(*hoststatp)) =
	    make_unstructured(new_ct, new_ce);

	DEBUG_STAT(7, "host new stat", *hoststatp);

	/*    NODE statement
	 */
	(*nodestatp) = MakeStatementLike(stat, is_instruction_unstructured);

	new_ct = (control) GET_CONTROL_MAPPING(nodemap, ct);
	new_ce = (control) GET_CONTROL_MAPPING(nodemap, ce);

	pips_assert("defined control",
		    !control_undefined_p(new_ct) && 
		    !control_undefined_p(new_ce));

	instruction_unstructured(statement_instruction(*nodestatp)) =
	    make_unstructured(new_ct, new_ce);

	DEBUG_STAT(7, "host new stat (again)", *hoststatp);
	
	gen_free_list(blocks);
	FREE_CONTROL_MAPPING(hostmap);
	FREE_CONTROL_MAPPING(nodemap);
    }
}

static void 
hpf_compile_sequential_loop(stat,hoststatp,nodestatp)
statement stat, *hoststatp, *nodestatp;
{
    loop the_loop=statement_loop(stat);
    statement body = loop_body(the_loop), hostbody, nodebody;
    range r=loop_range(the_loop);
    list /* of entities */ locals=loop_locals(the_loop);
    entity
	label = loop_label(the_loop),
	index = loop_index(the_loop),
	nindex = NewVariableForModule(node_module, index),
	hindex = NewVariableForModule(host_module, index);
    expression
	lower = range_lower(r),
	upper = range_upper(r),
	increment = range_increment(r);
    
    hpf_compiler(body, &hostbody, &nodebody);
    
    if (empty_code_p(hostbody))
    {
	/* ??? memory leak, hostbody is lost whatever it was.
	 */
	(*hoststatp)=make_continue_statement(entity_undefined);
    }
    else
    {
	(*hoststatp)=MakeStatementLike(stat, is_instruction_loop);

	instruction_loop(statement_instruction(*hoststatp))=
	  make_loop(hindex,
		    make_range(UpdateExpressionForModule(host_module,lower),
			       UpdateExpressionForModule(host_module,upper),
			    UpdateExpressionForModule(host_module,increment)),
		    hostbody,
		    label,
		    make_execution(is_execution_sequential,UU),
		    lNewVariableForModule(host_module,locals));
    }

    DEBUG_STAT(8, "host stat", *hoststatp);

    (*nodestatp)=MakeStatementLike(stat, is_instruction_loop);

    instruction_loop(statement_instruction(*nodestatp))=
	make_loop(nindex,
		  make_range(UpdateExpressionForModule(node_module,lower),
			     UpdateExpressionForModule(node_module,upper),
			     UpdateExpressionForModule(node_module,increment)),
		  nodebody,
		  label,
		  make_execution(is_execution_sequential,UU),
		  lNewVariableForModule(node_module,locals));

    DEBUG_STAT(8, "node stat", *nodestatp);
}

static void 
hpf_compile_parallel_body(body, hoststatp, nodestatp)
statement body, *hoststatp, *nodestatp;
{
    list lw = NIL, lr = NIL, li = NIL, ls = NIL, lbs = NIL;

    /* ???
     * dependances are not surely respected in the definitions list...
     * should check that only locals variables, that are not replicated,
     * may be defined during the body of the loop...
     */
    FindRefToDistArrayInStatement(body, &lw, &lr);
    li = AddOnceToIndicesList(lIndicesOfRef(lw), lIndicesOfRef(lr));
    ls = FindDefinitionsOf(body, li);
    gen_free_list(li), li=NIL;

    if (gen_length(lw)==0 && gen_length(lr)==0) /* very partial */
    {
	(*hoststatp) = copy_statement(body);
	(*nodestatp) = copy_statement(body);
    }
    else
    {
	generate_parallel_body(body, &lbs, lw, lr);
	
	(*hoststatp) = NULL;
	(*nodestatp) = make_block_statement(gen_nconc(ls, lbs));
    }

    gen_free_list(lw), lw=NIL;
    gen_free_list(lr), lr=NIL;
}

static void 
hpf_compile_parallel_loop(
    statement stat,
    statement *hoststatp,
    statement *nodestatp)
{
    loop the_loop = statement_loop(stat);
    statement s, nodebody, body = loop_body(the_loop);
    instruction bodyinst = statement_instruction(body);
    entity
	label = loop_label(the_loop),
	index = loop_index(the_loop),
	nindex = NewVariableForModule(node_module,index);
    range r = loop_range(the_loop);
    expression
	lower = range_lower(r),
	upper = range_upper(r),
	increment = range_increment(r);
    list lw=NIL, lr=NIL;

    FindRefToDistArrayInStatement(stat, &lw, &lr);
    
    if (lw||lr) 
    {
	pips_assert("parallel loop",
		    execution_parallel_p(loop_execution(the_loop)));
	
	if ((instruction_loop_p(bodyinst)) &&
	    (execution_parallel_p(loop_execution(instruction_loop(bodyinst)))))
	    hpf_compile_parallel_loop(body, &s, &nodebody);
	else
	    hpf_compile_parallel_body(body, &s, &nodebody);
    
	(*hoststatp) = make_continue_statement(entity_undefined);
	(*nodestatp) = MakeStatementLike(stat, is_instruction_loop);
	
	instruction_loop(statement_instruction(*nodestatp))=
	    make_loop(nindex,
		      make_range(UpdateExpressionForModule(node_module,lower),
				 UpdateExpressionForModule(node_module,upper),
			   UpdateExpressionForModule(node_module,increment)),
		      nodebody,
		      label,
		      make_execution(is_execution_sequential,UU),
		      NULL);
    } else {
	(*hoststatp) = copy_statement(stat);
	(*nodestatp) = copy_statement(stat);
    }

    gen_free_list(lw), gen_free_list(lr);

}

/* is there a parallel loop down s?
 */
static bool parallel_loop_found;
static bool loop_flt(loop l)
{
    if (execution_parallel_p(loop_execution(l))) {
	parallel_loop_found = true;
	gen_recurse_stop(NULL);
    }
    return !parallel_loop_found;
} 
static bool parallel_loop_in_stat_p(statement s)
{
    parallel_loop_found = false;
    gen_recurse(s, loop_domain, loop_flt, gen_null);
    return parallel_loop_found;
}

static void 
hpf_compile_loop(stat, hoststatp, nodestatp)
statement stat;
statement *hoststatp, *nodestatp;
{
    loop the_loop = instruction_loop(statement_instruction(stat));
    list l = NIL;
    entity var;
    bool is_shift = subarray_shift_p(stat, &var, &l);

    pips_assert("stat is a loop", statement_loop_p(stat));

    if (is_shift)
    {
	pips_debug(4, "shift detected\n");
	
	*nodestatp = generate_subarray_shift(stat, var, l);
	*hoststatp = make_empty_statement();
    }
    else if (execution_parallel_p(loop_execution(the_loop)))
    {
	reference left, right;
	bool /* should verify that only listed in labels and distributed
	      * entities are defined inside the body of the loop
	      */
	    at_ac = atomic_accesses_only_p(stat),
	    in_in = indirections_inside_statement_p(stat),
	    is_full_copy = full_copy_p(stat, &left, &right);
	
	pips_debug(5, "condition results: aa %d, in %d\n", at_ac, in_in);

	
	if (is_full_copy)
	{
	    pips_debug(4, "full copy detected\n");
	    
	    *nodestatp = generate_full_copy(left, right);
	    *hoststatp = make_empty_statement();
	}
	else if (at_ac && !in_in)
	{
	    statement overlapstat;

	    pips_debug(7, "compiling a parallel loop\n");

	    if (Overlap_Analysis(stat, &overlapstat))
	    {
		string c = statement_comments(stat);
		pips_debug(7, "overlap analysis succeeded\n");

		*hoststatp = make_continue_statement(entity_empty_label());
		*nodestatp = overlapstat;
		if (!string_undefined_p(c))
		    insert_comments_to_statement(*nodestatp, c);
	    }
	    else
	    {
		pips_debug(7, "overlap analysis is not ok...\n");

		if (parallel_loop_in_stat_p(loop_body(the_loop)))
		    hpf_compile_sequential_loop(stat, hoststatp, nodestatp);
		else
		    hpf_compile_parallel_loop(stat, hoststatp, nodestatp);
	    }
	}
	else
	{
	    pips_debug(7, "compiling a parallel loop sequential...\n");
	    hpf_compile_sequential_loop(stat, hoststatp, nodestatp);
	}
    }
    else
    {
	pips_debug(7,"compiling a sequential loop\n");
    
	hpf_compile_sequential_loop(stat, hoststatp, nodestatp);
    }
}

/* what: compile a statement into a host and SPMD node code.
 * how: double code rewriting in a recursive traversal of stat.
 * input: statement stat.
 * output: statements *hoststatp and *nodestatp
 * side effects: ?
 * bugs or features:
 *  - special care is made here of I/O and remappings.
 */
void 
hpf_compiler(
    statement stat,
    statement *hoststatp,
    statement *nodestatp)
{
    list /* of hpfc_reduction */ lr = NIL;
    bool root_statement_p = stat==get_current_module_statement();

    DEBUG_STAT(9, "stat is", stat);
    pips_debug(9, "only io %d, remapping %d, reduction %d\n",
	       load_statement_only_io(stat),
	       bound_renamings_p(stat),
	       bound_hpf_reductions_p(stat));

    if (load_statement_only_io(stat)==1) /* necessary */
    {
	io_efficient_compile(stat, hoststatp, nodestatp);
	return;
    }
    else if (bound_renamings_p(stat) && !root_statement_p) /* remapping */
    {
	remapping_compile(stat, hoststatp, nodestatp);
	return;
    }
    
    if (bound_hpf_reductions_p(stat)) /* HPF REDUCTION */
	lr = handle_hpf_reduction(stat);
    
    /* else usual stuff 
     */
    switch(instruction_tag(statement_instruction(stat)))
    {
    case is_instruction_block:
	hpf_compile_block(stat, hoststatp, nodestatp);
	break;
    case is_instruction_test:
	hpf_compile_test(stat, hoststatp, nodestatp);
	break;
    case is_instruction_loop:
	hpf_compile_loop(stat, hoststatp, nodestatp);
	break;
    case is_instruction_call:
	hpf_compile_call(stat, hoststatp, nodestatp);
	break;
    case is_instruction_unstructured:
	hpf_compile_unstructured(stat, hoststatp, nodestatp);
	break;
    case is_instruction_goto:
    default:
	pips_internal_error("unexpected instruction tag");
	break;
    }

    if (lr)
    {
	list /* of statement */ lh, ln;
	lh = gen_nconc(compile_hpf_reduction(lr, true, true),
         CONS(STATEMENT, *hoststatp,
	               compile_hpf_reduction(lr, false, true)));
	ln = gen_nconc(compile_hpf_reduction(lr, true, false),
	 CONS(STATEMENT, *nodestatp,
	               compile_hpf_reduction(lr, false, false)));

	*hoststatp = make_block_statement(lh);
	*nodestatp = make_block_statement(ln);
    }

    if (root_statement_p && bound_renamings_p(stat))
    {
	*nodestatp = make_block_statement(
	    CONS(STATEMENT, root_statement_remapping_inits(stat),
	    CONS(STATEMENT, *nodestatp, NIL)));
    }
}

/*   That is all
 */