/** **********************************************************************
** Module:  Expression \file expr.c
** This module implements the Expression abstraction.  Several
**  types of expressions are supported: identifiers, literals,
**  operations (arithmetic, logical, array indexing, etc.), and
**  function calls.  Every expression is marked with a type.
** Constants:
**  EXPRESSION_NULL     - the null expression
**  LITERAL_E       - a real literal with the value 2.7182...
**  LITERAL_EMPTY_SET   - a set literal representing the empty set
**  LITERAL_INFINITY    - a numeric literal representing infinity
**  LITERAL_PI      - a real literal with the value 3.1415...
**  LITERAL_ZERO        - an integer literal representing 0
**
************************************************************************/

/*
 * This software was developed by U.S. Government employees as part of
 * their official duties and is not subject to copyright.
 *
 * $Log: expr.c,v $
 * Revision 1.6  1997/01/21 19:19:51  dar
 * made C++ compatible
 *
 * Revision 1.5  1994/11/22  18:32:39  clark
 * Part 11 IS; group reference
 *
 * Revision 1.4  1994/11/10  19:20:03  clark
 * Update to IS
 *
 * Revision 1.3  1994/06/02  14:56:06  libes
 * made plus-like ops check both args
 *
 * Revision 1.2  1993/10/15  18:48:48  libes
 * CADDETC certified
 *
 * Revision 1.9  1993/02/22  21:46:00  libes
 * ANSI compat fixes
 *
 * Revision 1.8  1993/02/16  03:21:31  libes
 * fixed numerous confusions of type with return type
 * fixed implicit loop variable type declarations
 * improved errors
 *
 * Revision 1.7  1993/01/19  22:44:17  libes
 * *** empty log message ***
 *
 * Revision 1.6  1992/09/16  18:20:40  libes
 * made expression resolution routines search through references
 *
 * Revision 1.5  1992/08/18  17:13:43  libes
 * rm'd extraneous error messages
 *
 * Revision 1.4  1992/06/08  18:06:57  libes
 * prettied up interface to print_objects_when_running
 *
 * Revision 1.3  1992/05/31  23:32:26  libes
 * implemented ALIAS resolution
 *
 * Revision 1.2  1992/05/31  08:35:51  libes
 * multiple files
 *
 * Revision 1.1  1992/05/28  03:55:04  libes
 * Initial revision
 *
 * Revision 4.1  90/09/13  15:12:48  clark
 * BPR 2.1 alpha
 *
 */

#include <limits.h>
#include <assert.h>

#include "express/expr.h"
#include "express/resolve.h"


struct EXPop_entry EXPop_table[OP_LAST];

Expression  LITERAL_E = EXPRESSION_NULL;
Expression  LITERAL_INFINITY = EXPRESSION_NULL;
Expression  LITERAL_PI = EXPRESSION_NULL;
Expression  LITERAL_ZERO = EXPRESSION_NULL;
Expression  LITERAL_ONE;

void EXPop_init(void);

static inline int OPget_number_of_operands( Op_Code op ) {
    if( ( op == OP_NEGATE ) || ( op == OP_NOT ) ) {
        return 1;
    } else if( op == OP_SUBCOMPONENT ) {
        return 3;
    } else {
        return 2;
    }
}

/** Description: Initialize the Expression module. */
void EXPinitialize( void ) {
#ifdef does_not_appear_to_be_necessary_or_even_make_sense
    LITERAL_EMPTY_SET = EXPcreate_simple( Type_Set );
    LITERAL_EMPTY_SET->u.list = LISTcreate();
    resolved_all( LITERAL_EMPTY_SET );
#endif

    /* E and PI might come out of math.h */

    LITERAL_E = EXPcreate_simple( Type_Real );
#ifndef M_E
#define M_E     2.7182818284590452354
#endif
    LITERAL_E->u.real = M_E;
    resolved_all( LITERAL_E );

    LITERAL_PI = EXPcreate_simple( Type_Real );
#ifndef M_PI
#define M_PI    3.14159265358979323846
#endif
    LITERAL_PI->u.real = M_PI;
    resolved_all( LITERAL_PI );

    LITERAL_INFINITY = EXPcreate_simple( Type_Integer );
    LITERAL_INFINITY->u.integer = INT_MAX;
    resolved_all( LITERAL_INFINITY );

    LITERAL_ZERO = EXPcreate_simple( Type_Integer );
    LITERAL_ZERO->u.integer = 0;
    resolved_all( LITERAL_ZERO );

    LITERAL_ONE = EXPcreate_simple( Type_Integer );
    LITERAL_ONE->u.integer = 1;
    resolved_all( LITERAL_ONE );

    EXPop_init();
}

void EXPcleanup( void ) {
}

/**
 * \param selection the Type to look in (i.e. an enum)
 * \param sref the Symbol to be found
 * \param e set to the Expression found, when an enum is found
 * \param v set to the Variable found, when a variable is found
 * \param dt set to DICT_type when a match is found (use to determine whether to use e or v)
 * \param where used by ENTITYfind_inherited_attribute, not sure of purpose
 * \param s_id the search id, a parameter to avoid colliding with ENTITYfind...
 * there will be no ambiguities, since we're looking at (and marking)
 * only types, and it's marking only entities
 */
static int EXP_resolve_op_dot_fuzzy( Type selection, Symbol sref, Expression * e,
                                     Variable * v, char * dt, struct Symbol_ ** where, int s_id ) {
    Expression item;
    Variable tmp;
    int options = 0;
    struct Symbol_ *w = NULL;

    if( selection->search_id == s_id ) {
        return 0;
    }

    switch( selection->u.type->body->type ) {
        case entity_:
            /* goes through supertypes and their subtypes (!!) */
            tmp = ENTITYfind_inherited_attribute( selection->u.type->body->entity, sref.name, &w );
            if( tmp ) {
                if( w != NULL ) {
                    *where = w;
                }
                *v = tmp;
                *dt = DICT_type;
                return 1;
            } else {
                return 0;
            }
        case select_: {
            Linked_List supert = LISTcreate();
            Linked_List subt = LISTcreate();
            Linked_List uniqSubs = LISTcreate();
            selection->search_id = s_id;
            LISTdo( selection->u.type->body->list, t, Type ) {
                int nr = EXP_resolve_op_dot_fuzzy( t, sref, e, v, dt, &w, s_id );
                if( nr ) {
                    if( w != NULL ) {
                        /* only ever set due to ENTITYfind_inherited_attribute in case entity_.
                         * it is set to a subtype of one of the current type's supertypes. not
                         * sure of the circumstances in which this is beneficial.
                         */
                        *where = w;
                        LISTadd_last( subt, w );
                    } else {
                        LISTadd_last( supert, t );
                    }
                    options += nr;
                }
            } LISTod
            /* go through supertypes and subtypes, comparing. for any subtypes in supertypes, remove item from subtypes
             * would be possible to delete items from subt while going through the list... worth the effort?
             */
            LISTdo( subt, s, Symbol* ) {
                bool found = false;
                LISTdo_n( supert, t, Type, b ) {
                    if( 0 == strcmp( s->name, t->symbol.name ) ) {
                        found = true;
                        break;
                    }
                } LISTod
                if( !found ) {
                    LISTadd_last( uniqSubs, s );
                }
            } LISTod
            if( ( LISTget_length( uniqSubs ) == 0 ) && ( LISTget_length( supert ) == 1 ) && ( options > 1 ) ) {
                options = 1;
                /* this ensures that v is set correctly and wasn't overwritten */
                EXP_resolve_op_dot_fuzzy( (Type) LISTget_first( supert ), sref, e, v, dt, &w, s_id );
            }
            if( options > 1 ) {
                /* found more than one, so ambiguous */
                *v = VARIABLE_NULL;
            }
            LISTfree( supert );
            LISTfree( subt );
            LISTfree( uniqSubs );
            return options;
        }
        case enumeration_:
            item = ( Expression )DICTlookup( TYPEget_enum_tags( selection ), sref.name );
            if( item ) {
                *e = item;
                *dt = DICT_type;
                return 1;
            } else {
                return 0;
            }
        default:
            return 0;
    }
}

Type EXPresolve_op_dot( Expression expr, Scope scope ) {
    Expression op1 = expr->e.op1;
    Expression op2 = expr->e.op2;
    Variable v = 0;
    Expression item;
    Type op1type;
    bool all_enums = true; /* used by 'case select_' */

    /* stuff for dealing with select_ */
    int options = 0;
    char dt;
    struct Symbol_ *where = NULL;

    /* op1 is entity expression, op2 is attribute */
    /* could be very impossible to determine except */
    /* at run-time, .... */
    EXPresolve( op1, scope, Type_Dont_Care );
    if( is_resolve_failed( op1 ) ) {
        resolve_failed( expr );
        return( Type_Bad );
    }
    op1type = op1->return_type;

    switch( op1type->u.type->body->type ) {
        case generic_:
        case runtime_:
            /* defer */
            return( Type_Runtime );
        case select_:
            __SCOPE_search_id++;
            /* don't think this actually actually catches anything on the first go-round, but let's be consistent */
            op1type->search_id = __SCOPE_search_id;
            LISTdo( op1type->u.type->body->list, t, Type ) {
                /* this used to increment options by 1 if EXP_resolve_op_dot_fuzzy found 1 or more possibilities.
                 * thus the code for handling ambiguities was only used if the ambig was in the immediate type
                 * and not a supertype. don't think that's right...
                 */
                options += EXP_resolve_op_dot_fuzzy( t, op2->symbol, &item, &v, &dt, &where, __SCOPE_search_id );
            }
            LISTod;
            switch( options ) {
                case 0:
                    LISTdo( op1type->u.type->body->list, t, Type ) {
                        if( t->u.type->body->type != enumeration_ ) {
                            all_enums = false;
                        }
                    }
                    LISTod;

                    if( all_enums ) {
                        ERRORreport_with_symbol(CASE_SKIP_LABEL, &op2->symbol, op2->symbol.name );
                    } else {
                        /* no possible resolutions */
                        ERRORreport_with_symbol(UNDEFINED_ATTR, &op2->symbol, op2->symbol.name );
                    }
                    resolve_failed( expr );
                    return( Type_Bad );
                case 1:
                    /* only one possible resolution */
                    if( dt == OBJ_VARIABLE ) {
                        if( where ) {
                            ERRORreport_with_symbol(IMPLICIT_DOWNCAST, &op2->symbol, where->name );
                        }

                        if( v == VARIABLE_NULL ) {
                            fprintf( stderr, "EXPresolve_op_dot: nonsense value for Variable\n" );
                            ERRORabort( 0 );
                        }
                        op2->u.variable = v;
                        op2->return_type = v->type;
                        resolved_all( expr );
                        return( v->type );
                    } else if( dt == OBJ_ENUM ) {
                        op2->u.expression = item;
                        op2->return_type = item->type;
                        resolved_all( expr );
                        return( item->type );
                    } else {
                        fprintf( stderr, "EXPresolved_op_dot: attribute not an attribute?\n" );
                        ERRORabort( 0 );
                        return( Type_Bad );
                    }

                default:
                    /* compile-time ambiguous */
                    if( where ) {
                        /* this is actually a warning, not an error */
                        ERRORreport_with_symbol(AMBIG_IMPLICIT_DOWNCAST, &op2->symbol, where->name );
                    }
                    return( Type_Runtime );
            }
        case attribute_:
            v = ENTITYresolve_attr_ref( op1->u.variable->type->u.type->body->entity, ( struct Symbol_ * )0, &op2->symbol );

            if( !v ) {
                /*      reported by ENTITYresolve_attr_ref */
                /*      ERRORreport_with_symbol(ERROR_undefined_attribute,*/
                /*              &expr->symbol,op2->symbol.name);*/
                resolve_failed( expr );
                return( Type_Bad );
            }
            if( DICT_type != OBJ_VARIABLE ) {
                fprintf( stderr, "EXPresolved_op_dot: attribute not an attribute?\n" );
                ERRORabort( 0 );
            }

            op2->u.variable = v;
            op2->return_type = v->type;
            resolved_all( expr );
            return( v->type );
        case entity_:
        case op_:   /* (op1).op2 */
            v = ENTITYresolve_attr_ref( op1type->u.type->body->entity,
                                        ( struct Symbol_ * )0, &op2->symbol );
            if( !v ) {
                /*      reported by ENTITYresolve_attr_ref */
                /*      ERRORreport_with_symbol(ERROR_undefined_attribute,*/
                /*              &expr->symbol,op2->symbol.name);*/
                resolve_failed( expr );
                return( Type_Bad );
            }
            if( DICT_type != OBJ_VARIABLE ) {
                fprintf( stderr, "ERROR: EXPresolved_op_dot: attribute not an attribute?\n" );
            }

            op2->u.variable = v;
            /* changed to set return_type */
            op2->return_type = op2->u.variable->type;
            resolved_all( expr );
            return( op2->return_type );
        case enumeration_:
            /* enumerations within a select will be handled by `case select_` above,
             * which calls EXP_resolve_op_dot_fuzzy(). */
            item = ( Expression )DICTlookup( TYPEget_enum_tags( op1type ), op2->symbol.name );
            if( !item ) {
                ERRORreport_with_symbol(ENUM_NO_SUCH_ITEM, &op2->symbol,
                                         op1type->symbol.name, op2->symbol.name );
                resolve_failed( expr );
                return( Type_Bad );
            }

            op2->u.expression = item;
            op2->return_type = item->type;
            resolved_all( expr );
            return( item->type );
        case aggregate_:
        case array_:
        case bag_:
        case list_:
        case set_:
            ERRORreport_with_symbol(ATTRIBUTE_REF_ON_AGGREGATE,
                                     &op2->symbol, op2->symbol.name );
            /*FALLTHRU*/
        case unknown_:  /* unable to resolved operand */
            /* presumably error has already been reported */
            resolve_failed( expr );
            return( Type_Bad );
        default:
            ERRORreport_with_symbol(ATTRIBUTE_REF_FROM_NON_ENTITY,
                                     &op2->symbol, op2->symbol.name );
            resolve_failed( expr );
            return( Type_Bad );
    }
}

/**
 * \param s_id the search id, a parameter to avoid colliding with ENTITYfind...
 * there will be no ambiguities, since we're looking at (and marking)
 * only types, and it's marking only entities
 */
static int EXP_resolve_op_group_fuzzy( Type selection, Symbol sref, Entity * e,
                                       int s_id ) {
    Entity tmp;
    int options = 0;

    if( selection->search_id == s_id ) {
        return 0;
    }

    switch( selection->u.type->body->type ) {
        case entity_:
            tmp = ( Entity )ENTITYfind_inherited_entity(
                      selection->u.type->body->entity, sref.name, 1 );
            if( tmp ) {
                *e = tmp;
                return 1;
            }

            return 0;
        case select_:
            tmp = *e;
            selection->search_id = s_id;
            LISTdo( selection->u.type->body->list, t, Type )
            if( EXP_resolve_op_group_fuzzy( t, sref, e, s_id ) ) {
                if( *e != tmp ) {
                    tmp = *e;
                    ++options;
                }
            }
            LISTod;

            switch( options ) {
                case 0:
                    return 0;
                case 1:
                    return 1;
                default:
                    /* found more than one, so ambiguous */
                    *e = ENTITY_NULL;
                    return 1;
            }
        default:
            return 0;
    }
}

Type EXPresolve_op_group( Expression expr, Scope scope ) {
    Expression op1 = expr->e.op1;
    Expression op2 = expr->e.op2;
    Entity ent_ref = ENTITY_NULL;
    Entity tmp = ENTITY_NULL;
    Type op1type;

    /* stuff for dealing with select_ */
    int options = 0;

    /* op1 is entity expression, op2 is entity */
    /* could be very impossible to determine except */
    /* at run-time, .... */
    EXPresolve( op1, scope, Type_Dont_Care );
    if( is_resolve_failed( op1 ) ) {
        resolve_failed( expr );
        return( Type_Bad );
    }
    op1type = op1->return_type;

    switch( op1type->u.type->body->type ) {
        case generic_:
        case runtime_:
        case op_:
            /* All these cases are very painful to do right */
            /* "Generic" and sometimes others require runtime evaluation */
            op2->return_type = Type_Runtime;
            return( Type_Runtime );
        case self_:
        case entity_:
            /* Get entity denoted by "X\" */
            tmp = ( ( op1type->u.type->body->type == self_ )
                    ? scope
                    : op1type->u.type->body->entity );

            /* Now get entity denoted by "X\Y" */
            ent_ref =
                ( Entity )ENTITYfind_inherited_entity( tmp, op2->symbol.name, 1 );
            if( !ent_ref ) {
                ERRORreport_with_symbol(GROUP_REF_NO_SUCH_ENTITY,
                                         &op2->symbol, op2->symbol.name );
                resolve_failed( expr );
                return( Type_Bad );
            }

            op2->u.entity = ent_ref;
            op2->return_type = ent_ref->u.entity->type;
            resolved_all( expr );
            return( op2->return_type );
        case select_:
            __SCOPE_search_id++;
            /* don't think this actually actually catches anything on the */
            /* first go-round, but let's be consistent */
            op1type->search_id = __SCOPE_search_id;
            LISTdo( op1type->u.type->body->list, t, Type )
            if( EXP_resolve_op_group_fuzzy( t, op2->symbol, &ent_ref,
                                            __SCOPE_search_id ) ) {
                if( ent_ref != tmp ) {
                    tmp = ent_ref;
                    ++options;
                }
            }
            LISTod;

            switch( options ) {
                case 0:
                    /* no possible resolutions */
                    ERRORreport_with_symbol(GROUP_REF_NO_SUCH_ENTITY,
                                             &op2->symbol, op2->symbol.name );
                    resolve_failed( expr );
                    return( Type_Bad );
                case 1:
                    /* only one possible resolution */
                    op2->u.entity = ent_ref;
                    op2->return_type = ent_ref->u.entity->type;
                    resolved_all( expr );
                    return( op2->return_type );
                default:
                    /* compile-time ambiguous */
                    /*      ERRORreport_with_symbol(ERROR_ambiguous_group,*/
                    /*                  &op2->symbol, op2->symbol.name);*/
                    return( Type_Runtime );
            }
        case array_:
            if( op1->type->u.type->body->type == self_ ) {
                return( Type_Runtime ); /* not sure if there are other cases where Type_Runtime should be returned, or not */
            } /*  else fallthrough */
        case unknown_:  /* unable to resolve operand */
            /* presumably error has already been reported */
            resolve_failed( expr );
            return( Type_Bad );
        case aggregate_:

        case bag_:
        case list_:
        case set_:
        default:
            ERRORreport_with_symbol(GROUP_REF_UNEXPECTED_TYPE,
                                     &op1->symbol );
            return( Type_Bad );
    }
}

Type EXPresolve_op_relational( Expression e, Scope s ) {
    Type t = 0;
    int failed = 0;
    Type op1type;

    /* Prevent op1 from complaining if it fails */

    EXPresolve( e->e.op1, s, Type_Unknown );
    failed = is_resolve_failed( e->e.op1 );
    op1type = e->e.op1->return_type;

    /* now, either op1 was resolved in which case, we use its return type */
    /* for typechecking, OR, it wasn't resolved in which case we resolve */
    /* op2 in such a way that it complains if it fails to resolved */

    if( op1type == Type_Unknown ) {
        t = Type_Dont_Care;
    } else {
        t = op1type;
    }

    EXPresolve( e->e.op2, s, t );
    if( is_resolve_failed( e->e.op2 ) ) {
        failed = 1;
    }

    /* If op1 wasn't successfully resolved, retry it now with new information */

    if( ( failed == 0 ) && !is_resolved( e->e.op1 ) ) {
        EXPresolve( e->e.op1, s, e->e.op2->return_type );
        if( is_resolve_failed( e->e.op1 ) ) {
            failed = 1;
        }
    }

    if( failed ) {
        resolve_failed( e );
    } else {
        resolved_all( e );
    }
    return( Type_Logical );
}

void EXPresolve_op_default( Expression e, Scope s ) {
    int failed = 0;

    if( OPget_number_of_operands( e->e.op_code ) == 3 ) {
        EXPresolve( e->e.op3, s, Type_Dont_Care );
        failed = is_resolve_failed( e->e.op3 );
    }
    if( OPget_number_of_operands( e->e.op_code ) == 2 ) {
        EXPresolve( e->e.op2, s, Type_Dont_Care );
        failed |= is_resolve_failed( e->e.op2 );
    }
    EXPresolve( e->e.op1, s, Type_Dont_Care );
    if( failed || is_resolve_failed( e->e.op1 ) ) {
        resolve_failed( e );
    } else {
        resolved_all( e );
    }
}

/* prototype for this func cannot change - it is passed as a fn pointer */
Type EXPresolve_op_unknown( Expression e, Scope s ) {
    (void) e; /* quell unused param warning */
    (void) s;
    ERRORreport( INTERNAL_UNRECOGNISED_OP_IN_EXPRESOLVE );
    return Type_Bad;
}

typedef Type (Resolve_expr_func) ( Expression , Scope );

Type EXPresolve_op_logical( Expression e, Scope s ) {
    EXPresolve_op_default( e, s );
    return( Type_Logical );
}
Type EXPresolve_op_array_like( Expression e, Scope s ) {

    Type op1type;
    EXPresolve_op_default( e, s );
    op1type = e->e.op1->return_type;

    if( TYPEis_aggregate( op1type ) ) {
        return( op1type->u.type->body->base );
    } else if( TYPEis_string( op1type ) ) {
        return( op1type );
    } else if( op1type == Type_Runtime ) {
        return( Type_Runtime );
    } else if( op1type->u.type->body->type == binary_ ) {
        ERRORreport_with_symbol(WARN_UNSUPPORTED_LANG_FEAT, &e->symbol, "indexing on a BINARY", __FILE__, __LINE__ );
        return( Type_Binary );
    } else if( op1type->u.type->body->type == generic_ ) {
        return( Type_Generic );
    } else if( TYPEis_select( op1type ) ) {
        int numAggr = 0, numNonAggr = 0;
        bool sameAggrType = true;
        Type lasttype = 0;

        /* FIXME Is it possible that the base type hasn't yet been resolved?
         * If it is possible, we should signal that we need to come back later... but how? */
        assert( op1type->symbol.resolved == 1 );

        /* FIXME We should check for a not...or excluding non-aggregate types in the select, such as
         * WR1: NOT('INDEX_ATTRIBUTE.COMMON_DATUM_LIST' IN TYPEOF(base)) OR (SELF\shape_aspect.of_shape = base[1]\shape_aspect.of_shape);
         * (how?)
         */

        /* count aggregates and non-aggregates, check aggregate types */
        LISTdo( op1type->u.type->body->list, item, Type ) {
            if( TYPEis_aggregate( item ) ) {
                numAggr++;
                if( lasttype == TYPE_NULL ) {
                    lasttype = item;
                } else {
                    if( lasttype->u.type->body->type != item->u.type->body->type ) {
                        sameAggrType = false;
                    }
                }
            } else {
                numNonAggr++;
            }
        }
        LISTod;

        /* NOTE the following code returns the same data for every case that isn't an error.
         * It needs to be simplified or extended, depending on whether it works or not. */
        if( sameAggrType && ( numAggr != 0 ) && ( numNonAggr == 0 ) ) {
            /*  All are the same aggregation type */
            return( lasttype->u.type->body->base );
        } else if( numNonAggr == 0 ) {
            /*  All aggregates, but different types */
            ERRORreport_with_symbol(WARN_INDEXING_MIXED, &e->symbol, op1type->symbol.name );
            return( lasttype->u.type->body->base ); /*  WARNING I'm assuming that any of the types is acceptable!!! */
        } else if( numAggr != 0 ) {
            /*  One or more aggregates, one or more nonaggregates */
            ERRORreport_with_symbol(WARN_INDEXING_MIXED, &e->symbol, op1type->symbol.name );
            return( lasttype->u.type->body->base ); /*  WARNING I'm assuming that any of the types is acceptable!!! */
        }   /*  Else, all are nonaggregates. This is an error. */
    }
    ERRORreport_with_symbol(INDEXING_ILLEGAL, &e->symbol );
    return( Type_Unknown );
}

Type EXPresolve_op_entity_constructor( Expression e, Scope s ) {
    EXPresolve_op_default( e, s );
    /* perhaps should return Type_Runtime? */
    return Type_Entity;
}

Type EXPresolve_op_int_div_like( Expression e, Scope s ) {
    EXPresolve_op_default( e, s );
    return Type_Integer;
}

Type EXPresolve_op_plus_like( Expression e, Scope s ) {
    /* i.e., Integer or Real */
    EXPresolve_op_default( e, s );
    if( is_resolve_failed( e ) ) {
        resolve_failed( e );
        return( Type_Unknown );
    }

    /* could produce better results with a lot of pain but the EXPRESS */
    /* spec is a little confused so what's the point.  For example */
    /* it says bag+set=bag */
    /*     and set+bag=set */
    /*     and set+list=set */
    /*     and list+set=? */

    /* crude but sufficient */
    if( ( TYPEis_aggregate( e->e.op1->return_type ) ) ||
            ( TYPEis_aggregate( e->e.op2->return_type ) ) ) {
        return Type_Aggregate;
    }

    /* crude but sufficient */
    if( ( e->e.op1->return_type->u.type->body->type == real_ ) ||
            ( e->e.op2->return_type->u.type->body->type == real_ ) ) {
        return( Type_Real );
    }
    return Type_Integer;
}

Type EXPresolve_op_unary_minus( Expression e, Scope s ) {
    EXPresolve_op_default( e, s );
    return e->e.op1->return_type;
}

/** Initialize one entry in EXPop_table
 * This table's function pointers are resolved in EXP_resolve(), at approx resolve.c:520
 * \sa EXP_resolve()
 * \sa EXPop_init()
 *
 * \param token_number operator value, usually in macro form
 * \param string human-readable description
 * \param resolve_func   resolves an expression of this type
 */
void EXPop_create( int token_number, char * string, Resolve_expr_func * resolve_func ) {
    EXPop_table[token_number].token = string;
    EXPop_table[token_number].resolve = resolve_func;
}

void EXPop_init(void) {
    EXPop_create( OP_AND, "AND",      EXPresolve_op_logical );
    EXPop_create( OP_ANDOR, "ANDOR",      EXPresolve_op_logical );
    EXPop_create( OP_ARRAY_ELEMENT, "[array element]", EXPresolve_op_array_like );
    EXPop_create( OP_CONCAT, "||",        EXPresolve_op_entity_constructor );
    EXPop_create( OP_DIV, "/ (INTEGER)",  EXPresolve_op_int_div_like );
    EXPop_create( OP_DOT, ".",        EXPresolve_op_dot );
    EXPop_create( OP_EQUAL, "=",      EXPresolve_op_relational );
    EXPop_create( OP_EXP, "**",       EXPresolve_op_plus_like );
    EXPop_create( OP_GREATER_EQUAL, ">=", EXPresolve_op_relational );
    EXPop_create( OP_GREATER_THAN, ">",   EXPresolve_op_relational );
    EXPop_create( OP_GROUP, "\\",     EXPresolve_op_group );
    EXPop_create( OP_IN, "IN",        EXPresolve_op_relational );
    EXPop_create( OP_INST_EQUAL, ":=:",   EXPresolve_op_relational );
    EXPop_create( OP_INST_NOT_EQUAL, ":<>:",  EXPresolve_op_relational );
    EXPop_create( OP_LESS_EQUAL, "<=",    EXPresolve_op_relational );
    EXPop_create( OP_LESS_THAN, "<",      EXPresolve_op_relational );
    EXPop_create( OP_LIKE, "LIKE",        EXPresolve_op_relational );
    EXPop_create( OP_MINUS, "- (MINUS)",  EXPresolve_op_plus_like );
    EXPop_create( OP_MOD, "MOD",      EXPresolve_op_int_div_like );
    EXPop_create( OP_NEGATE, "- (NEGATE)",    EXPresolve_op_unary_minus );
    EXPop_create( OP_NOT, "NOT",      EXPresolve_op_logical );
    EXPop_create( OP_NOT_EQUAL, "<>",     EXPresolve_op_relational );
    EXPop_create( OP_OR, "OR",        EXPresolve_op_logical );
    EXPop_create( OP_PLUS, "+",       EXPresolve_op_plus_like );
    EXPop_create( OP_REAL_DIV, "/ (REAL)",    EXPresolve_op_plus_like );
    EXPop_create( OP_SUBCOMPONENT, "[:]", EXPresolve_op_array_like );
    EXPop_create( OP_TIMES, "*",      EXPresolve_op_plus_like );
    EXPop_create( OP_XOR, "XOR",      EXPresolve_op_logical );
    EXPop_create( OP_UNKNOWN, "UNKNOWN OP",   EXPresolve_op_unknown );
}

/**
** \param expression  expression to evaluate
** \param experrc buffer for error code
** \returns value of expression
** Compute the value of an integer expression.
*/
int EXPget_integer_value( Expression expression ) {
    /* TODO: why is this treated differently than a type error below? */
    if( expression == EXPRESSION_NULL ) {
        return 0;
    }
    if( expression->return_type->u.type->body->type == integer_ ) {
        return INT_LITget_value( expression );
    } else {
        ERRORreport(INTEGER_EXPRESSION_EXPECTED);
        return 0;
    }
}

char * opcode_print( Op_Code o ) {
    switch( o ) {
        case OP_AND:
            return( "OP_AND" );
        case OP_ANDOR:
            return( "OP_ANDOR" );
        case OP_ARRAY_ELEMENT:
            return( "OP_ARRAY_ELEMENT" );
        case OP_CONCAT:
            return( "OP_CONCAT" );
        case OP_DIV:
            return( "OP_DIV" );
        case OP_DOT:
            return( "OP_DOT" );
        case OP_EQUAL:
            return( "OP_EQUAL" );
        case OP_EXP:
            return( "OP_EXP" );
        case OP_GREATER_EQUAL:
            return( "OP_GREATER_EQUAL" );
        case OP_GREATER_THAN:
            return( "OP_GREATER_THAN" );
        case OP_GROUP:
            return( "OP_GROUP" );
        case OP_IN:
            return( "OP_IN" );
        case OP_INST_EQUAL:
            return( "OP_INST_EQUAL" );
        case OP_INST_NOT_EQUAL:
            return( "OP_INST_NOT_EQUAL" );
        case OP_LESS_EQUAL:
            return( "OP_LESS_EQUAL" );
        case OP_LESS_THAN:
            return( "OP_LESS_THAN" );
        case OP_LIKE:
            return( "OP_LIKE" );
        case OP_MINUS:
            return( "OP_MINUS" );
        case OP_MOD:
            return( "OP_MOD" );
        case OP_NEGATE:
            return( "OP_NEGATE" );
        case OP_NOT:
            return( "OP_NOT" );
        case OP_NOT_EQUAL:
            return( "OP_NOT_EQUAL" );
        case OP_OR:
            return( "OP_OR" );
        case OP_PLUS:
            return( "OP_PLUS" );
        case OP_REAL_DIV:
            return( "OP_REAL_DIV" );
        case OP_SUBCOMPONENT:
            return( "OP_SUBCOMPONENT" );
        case OP_TIMES:
            return( "OP_TIMES" );
        case OP_XOR:
            return( "OP_XOR" );
        case OP_UNKNOWN:
            return( "OP_UNKNOWN" );
        default:
            return( "no such op" );
    }
}