/* glplan2.c (l_expr) */

/*----------------------------------------------------------------------
-- Copyright (C) 2000, 2001, 2002 Andrew Makhorin <mao@mai2.rcnet.ru>,
--               Department for Applied Informatics, Moscow Aviation
--               Institute, Moscow, Russia. All rights reserved.
--
-- This file is a part of GLPK (GNU Linear Programming Kit).
--
-- GLPK 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 2, or (at your option)
-- any later version.
--
-- GLPK 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 GLPK; see the file COPYING. If not, write to the Free
-- Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
----------------------------------------------------------------------*/

#include <float.h>
#include <math.h>
#include <stdio.h>
#include <string.h>
#include "glplang.h"

/*----------------------------------------------------------------------
-- eval_const - compute constant model expression.
--
-- This routine performs the specified operation on one or two constant
-- model expressions and returns the resultant value. */

#define DBL_BIG (0.999 * DBL_MAX)

double eval_const(int op, double x, double y)
{     switch (op)
      {  case C_NEG: /* negation (unary minus) */
            x = - x;
            break;
         case C_ADD: /* addition */
            if (x > 0.0 && y > 0.0 && x > + DBL_BIG - y ||
                x < 0.0 && y < 0.0 && x < - DBL_BIG - y)
               fatal("(%g) + (%g) range error", x, y);
            x += y;
            break;
         case C_SUB: /* subtraction */
            if (x > 0.0 && y < 0.0 && x > + DBL_BIG + y ||
                x < 0.0 && y > 0.0 && x < - DBL_BIG + y)
               fatal("(%g) - (%g) range error", x, y);
            x -= y;
            break;
         case C_MUL: /* multiplication */
            if (fabs(y) > 1.0 && fabs(x) > DBL_BIG / fabs(y))
               fatal("(%g) * (%g) range error", x, y);
            x *= y;
            break;
         case C_DIV: /* division */
            if (y == 0.0)
               fatal("(%g) / (%g) domain error", x, y);
            if (fabs(y) < 1.0 && fabs(x) > DBL_BIG * fabs(y))
               fatal("(%g) / (%g) range error", x, y);
            x /= y;
            break;
         case C_LT: /* less than */
            x = (x < y ? 1.0 : 0.0);
            break;
         case C_LE: /* less than or equal to */
            x = (x <= y ? 1.0 : 0.0);
            break;
         case C_EQ: /* equal to */
            x = (x == y ? 1.0 : 0.0);
            break;
         case C_GE: /* greater than or equal to */
            x = (x >= y ? 1.0 : 0.0);
            break;
         case C_GT: /* greater than */
            x = (x > y ? 1.0 : 0.0);
            break;
         case C_NE: /* not equal to */
            x = (x != y ? 1.0 : 0.0);
            break;
         default:
            insist(op != op);
      }
      return x;
}

#undef DBL_BIG

/*----------------------------------------------------------------------
-- make_const - create model expression <constant>.
--
-- This routine creates a model expression which is <constant> and
-- returns a pointer to the created expression. */

EXPR *make_const(double con)
{     EXPR *expr;
      expr = get_atom(pdb->expr_pool);
      expr->head = expr->tail = get_atom(pdb->code_pool);
      expr->head->op = C_CON;
      expr->head->arg.con = con;
      expr->head->next = NULL;
      return expr;
}

/*----------------------------------------------------------------------
-- make_refer - create model expression <variable>.
--
-- This routine creates a model expression which is <variable> and
-- returns a pointer to the created expression.
--
-- It is assumed that spar points to an array of variables and memb
-- points to a member of this array. */

EXPR *make_refer(SPAR *spar, MEMB *memb)
{     EXPR *expr;
      insist(spar->type == 'V');
      insist(spar != NULL && memb != NULL);
      expr = get_atom(pdb->expr_pool);
      expr->head = expr->tail = get_atom(pdb->code_pool);
      expr->head->op = C_VAR;
      expr->head->arg.var.spar = spar;
      expr->head->arg.var.memb = memb;
      expr->head->next = NULL;
      return expr;
}

/*----------------------------------------------------------------------
-- erase_expr - delete model expression.
--
-- This routines deletes the specified model expression. It is allowed
-- that: a) expr is NULL; b) expression has no elements. */

void erase_expr(EXPR *expr)
{     if (expr != NULL)
      {  CODE *code;
         while (expr->head != NULL)
         {  code = expr->head;
            expr->head = code->next;
            free_atom(pdb->code_pool, code);
         }
         free_atom(pdb->expr_pool, expr);
      }
      return;
}

/*----------------------------------------------------------------------
-- make_expr - perform symbolical operation on model expressions.
--
-- This routine symbolically computes expression (op x) or (x op y),
-- where x and y are input model expressions, op is operation code, and
-- returns a pointer to the resultant expression.
--
-- Both input expressions x and y are destroyed on exit. */

EXPR *make_expr(int op, EXPR *x, EXPR *y)
{     switch (op)
      {  case C_NEG:
            /* unary operation */
            insist(x != NULL && y == NULL);
            if (x->head->op == C_CON && x->head->next == NULL)
            {  /* the operand is constant expression */
               x->head->arg.con =
                  eval_const(op, x->head->arg.con, 0.0);
            }
            else
            {  /* the operand is general expression */
               x->tail = x->tail->next = get_atom(pdb->code_pool);
               x->tail->op = op;
               x->tail->next = NULL;
            }
            break;
         case C_ADD:
         case C_SUB:
         case C_MUL:
         case C_DIV:
            /* binary operation */
            insist(x != NULL && y != NULL);
            if (x->head->op == C_CON && x->head->next == NULL &&
                y->head->op == C_CON && y->head->next == NULL)
            {  /* both operands are constant expression */
               x->head->arg.con =
                  eval_const(op, x->head->arg.con, y->head->arg.con);
            }
            else
            {  /* at least one operand is general expression */
               x->tail->next = y->head, y->head = NULL;
               x->tail = y->tail, y->tail = NULL;
               x->tail = x->tail->next = get_atom(pdb->code_pool);
               x->tail->op = op;
               x->tail->next = NULL;
            }
            erase_expr(y);
            break;
         default:
            insist(op != op);
      }
      return x;
}

/*----------------------------------------------------------------------
-- copy_expr - copy model expression.
--
-- This routine creates a copy of the specified model expression and
-- returns a pointer to it. The input model expression is not changed
-- on exit. */

EXPR *copy_expr(EXPR *expr)
{     EXPR *copy;
      CODE *code;
      insist(expr != NULL);
      insist(expr->head != NULL);
      copy = get_atom(pdb->expr_pool);
      copy->head = copy->tail = NULL;
      for (code = expr->head; code != NULL; code = code->next)
      {  CODE *temp;
         temp = get_atom(pdb->code_pool);
         memcpy(temp, code, sizeof(CODE));
         temp->next = NULL;
         if (copy->head == NULL)
            copy->head = temp;
         else
            copy->tail->next = temp;
         copy->tail = temp;
      }
      return copy;
}

/*----------------------------------------------------------------------
-- enclose_expr - enclose expression in parentheses.
--
-- This routine encloses the expression expr in parentheses (which is
-- used for converting to the infix notation) and returns a pointer to
-- the resultant expression. The input expression expr is destroyed on
-- exit. */

EXPR *enclose_expr(EXPR *expr)
{     CODE *code;
      /* prepend left parenthesis */
      code = get_atom(pdb->code_pool);
      code->op = C_LPN;
      code->next = expr->head;
      expr->head = code;
      /* append right parenthesis */
      code = get_atom(pdb->code_pool);
      code->op = C_RPN;
      code->next = NULL;
      expr->tail = expr->tail->next = code;
      return expr;
}

/*----------------------------------------------------------------------
-- infix_expr - convert expression to infix notation.
--
-- This routine converts the expression expr from the standard postfix
-- notation to the infix notation (for printing purposes) and returns a
-- pointer to the resultant expression. The input expression expr is
-- not changed on exit. */

EXPR *infix_expr(EXPR *expr)
{     struct cell { EXPR *expr; int prty; };
      struct cell *stack;
      int size, top, x_prty, y_prty, prty;
      EXPR *x, *y; CODE *code, *temp;
      size = stack_size(expr);
      stack = ucalloc(1+size, sizeof(struct cell));
      top = 0;
      for (code = expr->head; code != NULL; code = code->next)
      {  switch (code->op)
         {  case C_CON:
               if (code->arg.con >= 0.0)
               {  x = get_atom(pdb->expr_pool);
                  x->head = x->tail = get_atom(pdb->code_pool);
                  x->head->op = C_CON;
                  x->head->arg.con = + code->arg.con;
                  x->head->next = NULL;
                  top++, stack[top].expr = x, stack[top].prty = 2;
               }
               else
               {  x = get_atom(pdb->expr_pool);
                  x->head = get_atom(pdb->code_pool);
                  x->tail = get_atom(pdb->code_pool);
                  x->head->op = C_NEG;
                  x->head->next = x->tail;
                  x->tail->op = C_CON;
                  x->tail->arg.con = - code->arg.con;
                  x->tail->next = NULL;
                  top++, stack[top].expr = x, stack[top].prty = 0;
               }
               break;
            case C_VAR:
               x = get_atom(pdb->expr_pool);
               x->head = x->tail = get_atom(pdb->code_pool);
               x->head->op = C_VAR;
               x->head->arg.var.spar = code->arg.var.spar;
               x->head->arg.var.memb = code->arg.var.memb;
               x->head->next = NULL;
               top++, stack[top].expr = x, stack[top].prty = 2;
               break;
            case C_NEG:
               x = stack[top].expr, x_prty = stack[top].prty, top--;
               if (x_prty == 0) x = enclose_expr(x);
               temp = get_atom(pdb->code_pool);
               temp->op = C_NEG;
               temp->next = x->head, x->head = temp;
               top++, stack[top].expr = x, stack[top].prty = 0;
               break;
            case C_ADD:
            case C_SUB:
            case C_MUL:
            case C_DIV:
               prty = (code->op == C_ADD || code->op == C_SUB ? 0 : 1);
               y = stack[top].expr, y_prty = stack[top].prty, top--;
               x = stack[top].expr, x_prty = stack[top].prty, top--;
               if (prty > x_prty) x = enclose_expr(x);
               if (prty >= y_prty) y = enclose_expr(y);
               temp = get_atom(pdb->code_pool);
               temp->op = code->op;
               temp->next = y->head;
               x->tail->next = temp;
               x->tail = y->tail;
               free_atom(pdb->expr_pool, y);
               top++, stack[top].expr = x, stack[top].prty = prty;
               break;
            default:
               insist(code->op != code->op);
         }

      }
      insist(top == 1);
      expr = stack[1].expr;
      ufree(stack);
      return expr;
}

/*----------------------------------------------------------------------
-- print_expr - format and print expression.
--
-- This routine converts the expression expr from the standard postfix
-- notation to the infix (parenthesized) notation and then prints it. */

void print_expr(EXPR *expr)
{     CODE *code;
      insist(expr != NULL);
      expr = infix_expr(expr);
      for (code = expr->head; code != NULL; code = code->next)
      {  switch (code->op)
         {  case C_NOP:
               break;
            case C_CON:
               {  char str[50];
                  sprintf(str, "%.12g", code->arg.con);
                  outstr(str);
               }
               break;
            case C_VAR:
               {  SPAR *spar = code->arg.var.spar;
                  MEMB *memb = code->arg.var.memb;
                  outstr(spar->name);
                  if (spar->dim > 0)
                  {  int k;
                     outstr("[");
                     for (k = 0; k < spar->dim; k++)
                     {  if (k > 0) outstr(",");
                        outstr(memb->item[k]->name);
                     }
                     outstr("]");
                  }
               }
               break;
            case C_NEG:
               outstr("-"); break;
            case C_ADD:
               outstr(" + "); break;
            case C_SUB:
               outstr(" - "); break;
            case C_MUL:
               outstr(" * "); break;
            case C_DIV:
               outstr(" / "); break;
            case C_LPN:
               outstr("("); break;
            case C_RPN:
               outstr(")"); break;
            default:
               insist(code->op != code->op);
         }
      }
      erase_expr(expr);
      return;
}

/* eof */
