static char rcsid[] = "$Id: F-varutil.c,v 1.25 2000/12/19 08:22:45 m-hirano 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"

static expv		getTerminalExpr _ANSI_ARGS_((expr x, expv l));
static TYPE_DESC	getConstExprType _ANSI_ARGS_((expr x));

int
expr_is_param(x)
     expr x;
{
    if (EXPR_CODE(x) == IDENT) {
	ID id = declare_ident(EXPR_SYM(x), CL_UNKNOWN);
	if (ID_CLASS(id) == CL_PARAM) {
	    return TRUE;
	}
    }
    return FALSE;
}


expv
expr_param_value(x)
     expr x;
{
    if (EXPR_CODE(x) != IDENT) {
	return NULL;
    } else {
	ID id;
	id = declare_ident(EXPR_SYM(x), CL_UNKNOWN);
	if (ID_CLASS(id) == CL_PARAM) {
	    if (PARAM_COMPLEX(id) != NULL) {
		return PARAM_COMPLEX(id);
#ifdef ENABLE_QREAL
	    } else if (PARAM_QREAL(id) != NULL) {
		return PARAM_QREAL(id);
#endif /* ENABLE_QREAL */
	    } else {
		return ID_CONST(id);
	    }
	} else {
	    return NULL;
	}
    }
}


int
expr_is_constant(x)
     expr x;
{
    switch (EXPR_CODE(x)) {
	/* terminal */
	case COMPLEX_CONSTANT:
	case F_COMPLEX_CONSTANT:
	case F_TRUE_CONSTANT:
	case F_FALSE_CONSTANT:
	case F_FLOAT_CONSTANT:
	case F_DOUBLE_CONSTANT:
#ifdef ENABLE_QREAL
	case F_QREAL_CONSTANT:
	case QREAL_CONSTANT:
#endif /* ENABLE_QREAL */
	case STRING_CONSTANT:
	case INT_CONSTANT:
	case FLOAT_CONSTANT:
	case LONGLONG_CONSTANT: {
	    return TRUE;
	}
	case IDENT: {
	    return expr_is_param(x);
	}

	/* node */
	case COMPLEX_NODE: {
	    return (expr_is_constant(EXPR_ARG1(x)) &&
		    expr_is_constant(EXPR_ARG2(x)));
	}

	case F_UNARY_MINUS_EXPR:
	case UNARY_MINUS_EXPR: {
	    if (EXPR_ARG1(x) == NULL) {
		fatal("internal compiler error.");
	    }
	    return expr_is_constant(EXPR_ARG1(x));
	}

	case F_PLUS_EXPR:
	case F_MINUS_EXPR:
	case F_MUL_EXPR:
	case F_DIV_EXPR:
	case F_POWER_EXPR:
	case PLUS_EXPR:
	case MINUS_EXPR:
	case MUL_EXPR:
	case DIV_EXPR: {
	    if (EXPR_ARG1(x) == NULL) {
		fatal("internal compiler error.");
	    }
	    if (EXPR_ARG2(x) == NULL) {
		fatal("internal compiler error.");
	    }
	    if (expr_is_constant(EXPR_ARG1(x)) == FALSE) {
		return FALSE;
	    }
	    if (expr_is_constant(EXPR_ARG2(x)) == FALSE) {
		return FALSE;
	    }
	    return TRUE;
	}
	default: {
	    break;
	}
    }
    return FALSE;
}


int
expr_is_constant_zero(x)
     expr x;
{
    if (expr_is_constant(x) == TRUE) {
	switch (EXPR_CODE(x)) {
	    /* terminal */
	    case COMPLEX_CONSTANT:
	    case F_COMPLEX_CONSTANT: {
		if (expr_is_constant_zero(EXPR_ARG1(x)) == FALSE) {
		    return FALSE;
		}
		if (expr_is_constant_zero(EXPR_ARG2(x)) == FALSE) {
		    return FALSE;
		}
		return TRUE;
	    }

	    case F_TRUE_CONSTANT: {
		return FALSE;
	    }

	    case F_FALSE_CONSTANT: {
		return TRUE;
	    }
	    
	    case INT_CONSTANT: {
		if (EXPR_INT(x) == 0) {
		    return TRUE;
		} else {
		    return FALSE;
		}
	    }

	    case FLOAT_CONSTANT:
	    case F_FLOAT_CONSTANT:
	    case F_DOUBLE_CONSTANT: {
		if (EXPR_FLOAT(x) == 0.0) {
		    return TRUE;
		} else {
		    return FALSE;
		}
	    }

#ifdef ENABLE_QREAL
	    case F_QREAL_CONSTANT:
	    case QREAL_CONSTANT: {
		/* always FALSE cuz having struct initializer. */
		return FALSE;
	    }
#endif /* ENABLE_QREAL */
	    
	    case STRING_CONSTANT: {
		return FALSE;
	    }
	    
	    case LONGLONG_CONSTANT: {
		if (EXPR_LLINT_LOW(x) == 0 &&
		    EXPR_LLINT_HIGH(x) == 0) {
		    return TRUE;
		} else {
		    return FALSE;
		}
	    }

	    /* node */
	    case F_UNARY_MINUS_EXPR:
	    case UNARY_MINUS_EXPR: {
		if (EXPR_ARG1(x) == NULL) {
		    fatal("internal compiler error.");
		}
		return expr_is_constant_zero(EXPR_ARG1(x));
	    }

	    case F_POWER_EXPR: {
		if (EXPR_ARG1(x) == NULL) {
		    fatal("internal compiler error.");
		}
		if (EXPR_ARG2(x) == NULL) {
		    fatal("internal compiler error.");
		}
		/* x ** 0 = 1 */
		if (expr_is_constant_zero(EXPR_ARG2(x)) == TRUE) {
		    return FALSE;
		}
		/* 0 ** x = 0 */
		if (expr_is_constant_zero(EXPR_ARG1(x)) == TRUE) {
		    return TRUE;
		}
		return FALSE;
	    }

	    case F_PLUS_EXPR:
	    case F_MINUS_EXPR:
	    case F_MUL_EXPR:
	    case F_DIV_EXPR:
	    case PLUS_EXPR:
	    case MINUS_EXPR:
	    case MUL_EXPR:
	    case DIV_EXPR: {
		if (EXPR_ARG1(x) == NULL) {
		    fatal("internal compiler error.");
		}
		if (EXPR_ARG2(x) == NULL) {
		    fatal("internal compiler error.");
		}
		if (expr_is_constant_zero(EXPR_ARG1(x)) == FALSE) {
		    return FALSE;
		}
		if (expr_is_constant_zero(EXPR_ARG2(x)) == FALSE) {
		    return FALSE;
		}
		return TRUE;
	    }

	    case IDENT: {
		if (expr_is_param(x) == FALSE) {
		    return FALSE;
		}
		return expr_is_constant_zero(expr_param_value(x));
	    }
	    default: {
		break;
	    }
	}
    }
    return FALSE;
}

static expv
castToInt(v)
     expv v;
{
    expv ret = NULL;
    switch (EXPR_CODE(v)) {
	case INT_CONSTANT: {
	    ret = v;
	    break;
	}
#ifdef HAS_INT64
	case LONGLONG_CONSTANT: {
	    _omInt64_t i64 = EXPV_INT64_VALUE(v);
	    ret = expv_int_term(INT_CONSTANT, type_INT, (int)i64);
	    break;
	}
#endif /* HAS_INT64 */
	case FLOAT_CONSTANT: {
	    ret = expv_int_term(INT_CONSTANT, type_INT, (int)EXPV_FLOAT_VALUE(v));
	    break;
	}
	case COMPLEX_CONSTANT: {
	    ret = castToInt(EXPR_ARG1(v));
	    break;
	}
	default: {
	    break;
	}
    }
    if (ret == NULL) {
	return NULL;
    }
    if (EXPR_CODE(ret) != INT_CONSTANT) {
	return NULL;
    }
    return ret;
}


static expv
getTerminalExpr(x, l)
     expr x;
     expv l;
{
    if (l == NULL) {
	l = list0(LIST);
    }
    if (EXPR_CODE_IS_TERMINAL(EXPR_CODE(x))) {
	list_put_last(l, compile_expression(x));
    } else {
	list lp;
	FOR_ITEMS_IN_LIST(lp, x) {
	    getTerminalExpr(LIST_ITEM(lp), l);
	}
    }
    return l;
}


static TYPE_DESC
getConstExprType(x)
     expr x;
{
    expv l = getTerminalExpr(x, NULL);
    list lp;
    TYPE_DESC ret = BASIC_TYPE_DESC(TYPE_SHORT); /* minimum numeric type. */
    expv v;

    FOR_ITEMS_IN_LIST(lp, l) {
	v = LIST_ITEM(lp);
	if (!(IS_NUMERIC_CONST_V(v))) {
	    return EXPV_TYPE(v);
	}
	ret = max_type(ret, EXPV_TYPE(v));
    }
    return ret;
}


TYPE_DESC
expr_constant_type(x)
     expr x;
{
    TYPE_DESC tp = NULL;

    if (expr_is_constant(x) == TRUE) {
	tp = getConstExprType(x);
	if (tp == NULL) {
	    fatal("can't determine type of constant expression.");
	    return NULL;
	}
    }
    return tp;
}


expv
expr_constant_value(x, forceInt)
     expr x;
     int forceInt;
{
    expv ret = NULL;

    if (EXPR_CODE_IS_TERMINAL_OR_CONST(EXPR_CODE(x))) {
	return compile_terminal_node(x);
    }

    switch (EXPR_CODE(x)) {
	case F_POWER_EXPR:
	case F_UNARY_MINUS_EXPR:
	case UNARY_MINUS_EXPR:
	case F_PLUS_EXPR:
	case F_MINUS_EXPR:
	case F_MUL_EXPR:
	case F_DIV_EXPR:
	case PLUS_EXPR:
	case MINUS_EXPR:
	case MUL_EXPR:
	case DIV_EXPR: {

	    if (expr_is_constant(x) == TRUE) {
		TYPE_DESC tp = getConstExprType(x);

		if (tp == NULL) {
		    fatal("can't determine type of constant expression.");
		    break;
		}
		if (!(IS_NUMERIC(tp))) {
		    expv new = expv_reduce(compile_expression(x));
		    if (new != NULL) {
			if (expr_is_constant(new) == TRUE) {
			    ret = new;
			}
		    }
		} else {
		    switch (TYPE_BASIC_TYPE(tp)) {
#ifdef ENABLE_QREAL
			case TYPE_QREAL: {
			    ret = expv_qreal_const_reduce(x);
			    break;
			}
#endif /* ENABLE_QREAL */
			case TYPE_COMPLEX:
			case TYPE_DCOMPLEX: {
			    ret = expv_complex_const_reduce(x, tp);
			    break;
			}

			default: {
			    expv new = expv_reduce(compile_expression(x));
			    if (expr_is_constant(new) == TRUE) {
				ret = new;
			    }
			    break;
			}
		    }
		}
	    }
	    break;
	}

	default: {
	    break;
	}
    }

    if (ret == NULL) {
	return NULL;
    }
    if (forceInt == TRUE) {
	return castToInt(ret);
    }
    return ret;
}


int
expr_is_variable(x, force, idPtr)
     expr x;
     int force;
     ID *idPtr;
{
    ID id = NULL;
    expr varName;
    int ret = FALSE;

    switch (EXPR_CODE(x)) {
        case IDENT: {
            varName = x;
            break;
        }
	case F_SUBSTR_REF:
        case F_ARRAY_REF: {
            varName = EXPR_ARG1(x);
            break;
        }
        default: {
	    goto Done;
        }
    }

    id = declare_ident(EXPR_SYM(varName), CL_UNKNOWN);
    if (force == TRUE) {
	if (ID_CLASS(id) == CL_UNKNOWN) {
	    ID_CLASS(id) = CL_VAR;
	}
	if (ID_CLASS(id) == CL_VAR) {
	    declare_variable(id);
	}
    }
    if (ID_CLASS(id) == CL_VAR) {
	ret = TRUE;
    }

    Done:
    if (idPtr != NULL) {
	*idPtr = id;
    }
    return ret;
}


int
expr_is_array(x, force, idPtr)
     expr x;
     int force;
     ID *idPtr;
{
    ID id = NULL;
    int ret = FALSE;

    if (expr_is_variable(x, force, &id) == TRUE) {
	if (IS_ARRAY_TYPE(ID_TYPE(id))) {
	    ret = TRUE;
	}
    }

    if (idPtr != NULL) {
	*idPtr = id;
    }
    
    return ret;
}


static void
getArrayDimSpec(tp, new)
     TYPE_DESC tp;
     expv new;
{
    if (TYPE_REF(tp) != NULL) {
	expv sV;
	fix_array_dimensions(tp);
	getArrayDimSpec(TYPE_REF(tp), new);
	sV = list3(LIST,
		   TYPE_DIM_SIZE(tp),
		   TYPE_DIM_LOWER(tp),
		   TYPE_DIM_UPPER(tp));
	list_put_last(new, sV);
    }
}


expv
id_array_dimension_list(id)
     ID id;
{
    expv ret = NULL;

    if (IS_ARRAY_TYPE(ID_TYPE(id))) {
	ret = list0(LIST);
	getArrayDimSpec(ID_TYPE(id), ret);
    }
    return ret;
}


expv
id_array_spec_list(id)
     ID id;
{
    expv ret = NULL;

    if (IS_ARRAY_TYPE(ID_TYPE(id))) {
	ret = list2(LIST,
		    expv_int_term(INT_CONSTANT, type_INT, TYPE_N_DIM(ID_TYPE(id))),
		    id_array_dimension_list(id));
    }
    return ret;
}


expv
expr_array_spec_list(x, idPtr)
     expr x;
     ID *idPtr;
{
    ID id = NULL;
    expv ret = NULL;

    if (expr_is_array(x, TRUE, &id) == FALSE) {
	if (id != NULL) {
	    VAR_ARRAY_INFO(id) = NULL;
	}
	goto Done;
    }
    if (VAR_ARRAY_INFO(id) == NULL) {
	ret = id_array_spec_list(id);
	VAR_ARRAY_INFO(id) = ret;
    } else {
	ret = VAR_ARRAY_INFO(id);
    }

    Done:
    if (idPtr != NULL) {
	*idPtr = id;
    }
    return ret;
}


int
compute_element_offset(aSpec, idxV)
     expv aSpec;	/* VAR_ARRAY_INFO(id)
			   or
			   expr_array_spec_list(expr, ID *) */
     expv idxV;		/* (LIST (INT_CONSTANT xx) (INT_CONSTANT xx) ...) */
{
    int mul = 1;
    int off = 0;
    int i;
    int n = EXPV_INT_VALUE(EXPR_ARG1(aSpec));
    expv v = EXPR_ARG2(aSpec);
    expv cDimV;
    int cIdx;
    int idxDim = 0;
    list lp;

    FOR_ITEMS_IN_LIST(lp, idxV) {
	idxDim++;
    }
    if (n != idxDim) {
	error("invalid dimension, array = %d, index = %d.\n",
	      n, idxDim);
	return -1;
    }

    for (i = 0; i < n; i++) {
	cDimV = expr_list_get_n(v, i);
	if (cDimV == NULL) {
	    error("can't get array offset to initialize.");
	    return -1;
	}
	cIdx = EXPV_INT_VALUE(expr_list_get_n(idxV, i)) - EXPV_INT_VALUE(EXPR_ARG2(cDimV));
	off += mul * cIdx;
	mul *= EXPV_INT_VALUE(EXPR_ARG1(cDimV));
    }
    return off;
}


expv
expr_array_index(x)
     expr x;
{
    expr idx;
    list lp;
    expr y;
    expv ret;
    expv tmp;

    if (expr_is_array(x, FALSE, NULL) == FALSE) {
	return NULL;
    }
    idx = EXPR_ARG2(x);
    ret = list0(LIST);

    FOR_ITEMS_IN_LIST(lp, idx) {
	y = LIST_ITEM(lp);

	switch (EXPR_CODE(y)) {
	    case INT_CONSTANT: {
		tmp = expv_int_term(INT_CONSTANT, type_INT, EXPR_INT(y));
		break;
	    }
	    default: {
		tmp = expr_constant_value(y, TRUE);
		if (tmp == NULL) {
		    error("array index is not a constant.");
		    return NULL;
		}
		break;
	    }
	}
	ret = list_put_last(ret, tmp);
    }

    return ret;
}