/* glplan1.c (l_decl) */

/*----------------------------------------------------------------------
-- 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 <ctype.h>
#include <string.h>
#include "glplang.h"

/*----------------------------------------------------------------------
-- set_decl - parse set declaration.
--
-- This routine parses set declaration which has the following form:
--
--    set name = ( item , ... , item ) , ... , name = ( ) ;
--
-- Each set declaration also involves implicit declaration of all its
-- items. */

void set_decl(void)
{     SPAR *spar;
      ITEM *first, *last, *item;
      MEMB *memb;
      AVLNODE *node;
      get_token(/* set */);
loop: if (token != T_NAME)
         fatal("set name missing or invalid");
      if (find_by_key(pdb->tree, image) != NULL)
         fatal("multiple declaration for `%s'", image);
      /* create set */
      spar = get_atom(pdb->spar_pool);
      strcpy(spar->name, image);
      spar->type = 'S';
      spar->dim = 1;
      spar->set[0] = spar;
      spar->mute[0] = '?';
      spar->first = spar->last = NULL;
      get_token(/* set name */);
      /* add to the symbol table */
      node = insert_by_key(pdb->tree, spar->name);
      node->type = 'S';
      node->link = spar;
      /* check delimiters */
      if (!t_spec("=")) fatal("equal sign expected");
      get_token(/* = */);
      if (!t_spec("(")) fatal("left parenthesis expected");
      get_token(/* ( */);
      /* parse item list */
      if (t_spec(")")) goto skip; /* list is empty */
      first = last = NULL;
      for (;;)
      {  if (token != T_NAME)
            fatal("item name missing or invalid");
         if (find_by_key(pdb->tree, image))
            fatal("multiple declaration for `%s'", image);
         /* create item */
         item = get_atom(pdb->item_pool);
         strcpy(item->name, image);
         item->set = spar;
         item->prev = last, item->next = NULL;
         if (first == NULL)
            first = item;
         else
            last->next = item;
         last = item;
         get_token(/* item name */);
         /* add to the symbol table */
         node = insert_by_key(pdb->tree, item->name);
         node->type = 'I';
         node->link = item;
         /* create set member */
         memb = get_atom(pdb->memb_pool);
         memb->item[0] = item;
         memb->link = NULL;
         memb->next = NULL;
         if (spar->first == NULL)
            spar->first = memb;
         else
            spar->last->next = memb;
         spar->last = memb;
         /* check delimiters */
         if (t_spec(")")) break;
         if (t_spec(",")) get_token(/* , */);
      }
skip: get_token(/* ) */);
      /* check delimiters */
      if (t_spec(","))
      {  get_token(/* , */);
         goto loop;
      }
      if (!t_spec(";")) fatal("semicolon expected");
      get_token(/* ; */);
      return;
}

/*----------------------------------------------------------------------
-- array_decl - parse predicate, parameter, or constraint declaration.
--
-- This routine parses predicate, parameter, or constraint declaration
-- which has the following form:
--
--    predicate  name , name [ S , ... , S ] , ... ;
--
--    parameter  name , name [ S , ... , S ] , ... ;
--
--    constraint name , name [ S , ... , S ] , ... ;
--
-- Initially predicate, parameter, or constraint has no elements. */

void array_decl(int type)
{     SPAR *spar;
      AVLNODE *node;
      char *what;
      switch (type)
      {  case 'P': what = "predicate";  break;
         case 'X': what = "parameter";  break;
         case 'C': what = "constraint"; break;
         default: insist(type != type);
      }
      get_token(/* predicate | array */);
loop: if (token != T_NAME)
         fatal("%s name missing or invalid", what);
      if (find_by_key(pdb->tree, image) != NULL)
         fatal("multiple declaration for `%s'", image);
      /* create array */
      spar = get_atom(pdb->spar_pool);
      strcpy(spar->name, image);
      spar->type = type;
      spar->dim = 0;
      spar->first = spar->last = NULL;
      get_token(/* array name */);
      /* add to the symbol table */
      node = insert_by_key(pdb->tree, spar->name);
      node->type = type;
      node->link = spar;
      /* parse optional domain list */
      if (t_spec("["))
      {  get_token(/* [ */);
         for (;;)
         {  if (token != T_NAME)
               fatal("set name missing or invalid");
            node = find_by_key(pdb->tree, image);
            if (node == NULL)
               fatal("set `%s' not declared", image);
            if (node->type != 'S')
               fatal("invalid use of `%s'", image);
            if (spar->dim == MAX_DIM)
               fatal("%s dimension too high", what);
            spar->set[spar->dim] = node->link;
            spar->mute[spar->dim] = '?';
            spar->dim++;
            get_token(/* set name */);
            /* check delimiters */
            if (t_spec("]")) break;
            if (!t_spec(",")) fatal("missing right bracket");
            get_token(/* , */);
         }
         get_token(/* ] */);
      }
      /* check delimiters */
      if (t_spec(","))
      {  get_token(/* , */);
         goto loop;
      }
      if (!t_spec(";")) fatal("semicolon expected");
      get_token(/* ; */);
      return;
}

/*----------------------------------------------------------------------
-- var_decl - parse variable declaration.
--
-- This routine parses variable declaration which has the following
-- form:
--
--    variable name , ... , name [ S , ... , S ] ;
--
--    variable name [ i in S , ... , i in S ] , ... ;
--
--    variable name [ i in S , ... , i in S ] where <predicate> , ... ;
--
-- If a predicate is not specified, the routine assumes the predicate
-- which is *true* on all elements of the Cartesian product. */

void var_decl(int kind)
{     SPAR *spar, *cond;
      AVLNODE *node;
      MEMB *memb; VAR *var;
      insist(kind == 0 || kind == 1 || kind == 2);
      get_token(/* variable | integer | binary */);
loop: if (token != T_NAME)
         fatal("variable name missing or invalid");
      if (find_by_key(pdb->tree, image) != NULL)
         fatal("multiple declaration for `%s'", image);
      /* create array */
      spar = get_atom(pdb->spar_pool);
      strcpy(spar->name, image);
      spar->type = 'V';
      spar->dim = 0;
      spar->first = spar->last = NULL;
      get_token(/* array name */);
      /* parse optional domain list */
      if (t_spec("["))
      {  int mute = 0;
         char name[MAX_NAME+1];
         get_token(/* [ */);
         for (;;)
         {  if (mute == 0)
            {  /* it is known yet what form is used */
               if (token != T_NAME)
                  fatal("mute letter or set name missing or invalid");
               strcpy(name, image);
               get_token(/* mute letter | set name */);
               if (!t_name("in"))
               {  mute = '?';
                  goto skip2;
               }
            }
            else if (mute == '?')
            {  /* form x[S] is used */
               goto skip1;
            }
            else
            {  /* form name[i in S] is used */
               if (token != T_NAME)
                  fatal("mute letter missing or invalid");
               strcpy(name, image);
               get_token(/* mute letter */);
            }
            if (!(strlen(name) == 1 && islower(name[0])))
               fatal("invalid mute letter `%s'", name);
            mute = name[0];
            if (find_mute(spar->dim, spar->mute, mute) >= 0)
               fatal("duplicate mute letter `%c'", mute);
            if (!t_name("in"))
               fatal("missing keyword `in'");
            get_token(/* in */);
skip1:      if (token != T_NAME)
               fatal("set name missing or invalid");
            strcpy(name, image);
            get_token(/* set name */);
skip2:      node = find_by_key(pdb->tree, name);
            if (node == NULL)
               fatal("set `%s' not declared", name);
            if (node->type != 'S')
               fatal("invalid use of `%s'", name);
            if (spar->dim == MAX_DIM)
               fatal("variable dimension too high");
            spar->set[spar->dim] = node->link;
            spar->mute[spar->dim] = mute;
            spar->dim++;
            /* check delimiters */
            if (t_spec("]")) break;
            if (!t_spec(",")) fatal("missing right bracket");
            get_token(/* , */);
         }
         get_token(/* ] */);
      }
      /* parse optional condition */
      if (t_name("where"))
      {  int k, t;
         /* if the variable block is not a scalar and mute letters are
            not used, the condition is not allowed */
         if (spar->dim > 0 && spar->mute[0] == '?')
            fatal("mute letter(s) required");
         get_token(/* where */);
         cond = expression();
         /* the condition should be a predicate */
         if (cond->type != 'P')
            fatal("expression following `where' must be predicate");
         /* each mute letter in the predicate should be presented in
            the variable array; besides, domains should be identical */
         for (k = 0; k < cond->dim; k++)
         {  t = find_mute(spar->dim, spar->mute, cond->mute[k]);
            if (t < 0)
               fatal("mute letter `%c' missing in variable prototype",
                  cond->mute[k]);
            if (spar->set[t] != cond->set[k])
               fatal("mute letter `%c' refers to different sets",
                  cond->mute[k]);
         }
         /* each mute letter in the variable array which is missing in
            the predicate involves increasing predicate dimension */
         for (k = 0; k < spar->dim; k++)
         {  t = find_mute(cond->dim, cond->mute, spar->mute[k]);
            if (t < 0)
               cond = expand_spar(cond, spar->set[k], spar->mute[k]);
         }
      }
      else
      {  /* condition is not specified; by default it is 0ary predicate
            (assertion) *true* */
         int k;
         cond = get_atom(pdb->spar_pool);
         strcpy(cond->name, "<true>");
         cond->type = 'P';
         cond->dim = 0;
         cond->first = spar->last = get_atom(pdb->memb_pool);
         cond->first->link = NULL;
         cond->first->next = NULL;
         /* increase predicate dimension in order to build a predicate
            which is *true* on all elements of the cartesian product */
         for (k = 0; k < spar->dim; k++)
            cond = expand_spar(cond, spar->set[k], '?');
      }
      /* add variable array to the symbol table */
      node = insert_by_key(pdb->tree, spar->name);
      node->type = 'V';
      node->link = spar;
      /* now the predicate is defined on the same cartesian product as
         the variable array; thus, each element of the predicate gives
         the corresponding element of the variable array */
      spar->first = cond->first;
      spar->last = cond->last;
      free_atom(pdb->spar_pool, cond);
      /* assign model variables to elements of the variable array */
      for (memb = spar->first; memb != NULL; memb = memb->next)
      {  memb->link = var = get_atom(pdb->var_pool);
         switch (kind)
         {  case 0:
               /* continuous non-negative */
               var->kind = 0;
               var->type = 'L';
               var->lb = var->ub = 0.0;
               break;
            case 1:
               /* integer non-negative */
               var->kind = 1;
               var->type = 'L';
               var->lb = var->ub = 0.0;
               break;
            case 2:
               /* binary */
               var->kind = 1;
               var->type = 'D';
               var->lb = 0.0, var->ub = 1.0;
               break;
            default:
               insist(kind != kind);
         }
      }
      /* check delimiters */
      if (t_spec(","))
      {  get_token(/* , */);
         goto loop;
      }
      if (!t_spec(";")) fatal("semicolon expected");
      get_token(/* ; */);
      return;
}

/* eof */
