static char rcsid[] = "$Id: F-TEA.c,v 1.3 2000/10/30 02:13:09 msato Exp $";
/* 
 * $RWC_Release: Omni-1.6 $
 * $RWC_Copyright:
 *  Omni Compiler Software Version 1.5-1.6
 *  Copyright (C) 2002 PC Cluster Consortium
 *  
 *  This software is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU Lesser General Public License version
 *  2.1 published by the Free Software Foundation.
 *  
 *  Omni Compiler Software Version 1.0-1.4
 *  Copyright (C) 1999, 2000, 2001.
 *   Tsukuba Research Center, Real World Computing Partnership, Japan.
 *  
 *  Please check the Copyright and License information in the files named
 *  COPYRIGHT and LICENSE under the top  directory of the Omni Compiler
 *  Software release kit.
 *  
 *  
 *  $
 */
#include "F-front.h"

void TEA_map_bound(expr x);
expr TEA_array_bound(TYPE_DESC tp);

void compile_OMN_directive(expr x)
{
    expr dir;
    list lp;

    if(x == NULL) return; /* error */

    if(debug_flag){
	printf("OMN_directive:\n");
	expv_output(x,stdout);
	printf("\n");
    }

    dir = EXPR_ARG1(x);
    
    switch(EXPR_INT(dir)){
    case TEA_DATAMAP:	/* (LIST dir (LIST alignee-list align-target) */
	FOR_ITEMS_IN_LIST(lp,EXPR_ARG1(EXPR_ARG2(x)))
	    TEA_map_bound(LIST_ITEM(lp));
	TEA_map_bound(EXPR_ARG2(EXPR_ARG2(x)));
	x = list2(TEA_PRAGMA,dir,EXPR_ARG2(x));

	if(current_directives == NULL)
	    current_directives = list1(LIST,x);
	else
	    list_put_last(current_directives,x);
	break;
    default:
	fatal("tea pragma %d is not implmented",EXPR_INT(dir));
    }
}

expr TEA_map_expr(expr x)
{
    switch(EXPR_CODE(x)){
    case IDENT:
    case INT_CONSTANT:
	return x;
    case F_MINUS_EXPR:
	EXPR_CODE(x) = MINUS_EXPR;
	break;
    case F_PLUS_EXPR:
	EXPR_CODE(x) = PLUS_EXPR;
	break;
    case F_MUL_EXPR:
	EXPR_CODE(x) = MUL_EXPR;
	break;
    default:
	error("bad expression in mapping description");
	return x;
    }
    TEA_map_expr(EXPV_LEFT(x));
    TEA_map_expr(EXPV_RIGHT(x));
    return x;
}

void TEA_map_bound(expr x)	/* (LIST (IDENT t) dist) */
{
    expr ident,bound,v;
    ID id;
    list lp;

    if(x == NULL) return;

    ident = EXPR_ARG1(x);
    if(EXPR_CODE(ident) != IDENT) fatal("TEA_map_bound: bad ident");

    FOR_ITEMS_IN_LIST(lp,EXPR_ARG2(x)){
	v = LIST_ITEM(lp);
	if(v != NULL && EXPR_INT(EXPR_ARG1(v)) == TEA_MAP_EXPR){
	    TEA_map_expr(EXPR_ARG2(v));
	}
    }

    /* if ident is not declared, it may be template */
    if((id = find_ident(EXPR_SYM(ident))) == NULL) {
	error("variable '%s' for mapping is not defined",
	      SYM_NAME(EXPR_SYM(ident)));
	return;
    }

    bound = TEA_array_bound(ID_TYPE(id));
    if(bound == NULL) error("bad variable '%s' for mapping",ID_NAME(id));
    list_put_last(x,bound);
}

expr TEA_array_bound(TYPE_DESC tp)
{
    expr l;

    if(!IS_ARRAY_TYPE(tp)) return NULL;
    if(TYPE_ARRAY_SIZE(tp) < 0) return NULL;  /* adjustable array */

    l = EMPTY_LIST;
    do {
	list_put_last(l,list2(LIST,TYPE_DIM_LOWER(tp),TYPE_DIM_UPPER(tp)));
	tp = TYPE_REF(tp);
    } while(IS_ARRAY_TYPE(tp));

    return l;
}