/* glplan6.c (l_spar.c) */

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

/*----------------------------------------------------------------------
-- erase_spar - delete sparse array.
--
-- This routine deletes the specified sparse array. The array should be
-- only predicate or array of model expressions. */

void erase_spar(SPAR *spar)
{     MEMB *memb;
      insist(spar->type == 'P' || spar->type == 'X');
      while (spar->first != NULL)
      {  memb = spar->first;
         spar->first = memb->next;
         if (spar->type == 'X') erase_expr(memb->link);
         free_atom(pdb->memb_pool, memb);
      }
      free_atom(pdb->spar_pool, spar);
      return;
}

/*----------------------------------------------------------------------
-- expand_spar - expand dimension of sparse array over given set.
--
-- This routine builds the sparse array
--
--    y[p,...,q,i] = x[p,...,q] for all i in S
--
-- where x is a given array, S is a given (index) set, i is a new mute
-- letter assigned to the new dimension.
--
-- The routine returns a pointer to the array y. The input array x is
-- destroyed on exit. */

SPAR *expand_spar(SPAR *x, SPAR *set, int i)
{     SPAR *y; MEMB *memx, *memy, *memb;
      insist(x->type == 'P' || x->type == 'X');
      insist(x->dim < MAX_DIM);
      insist(set->type == 'S');
      /* create the resultant array of higher dimension */
      y = get_atom(pdb->spar_pool);
      memcpy(y, x, sizeof(SPAR));
      y->set[y->dim] = set;
      y->mute[y->dim] = i;
      y->dim++;
      y->first = y->last = NULL;
      /* each element of x gives an one-dimensioned array of identical
         elements over the set S */
      for (memx = x->first; memx != NULL; memx = memx->next)
      {  for (memb = set->first; memb != NULL; memb = memb->next)
         {  /* create and add new element to the resultant array */
            memy = get_atom(pdb->memb_pool);
            memcpy(memy, memx, sizeof(MEMB));
            memy->item[y->dim-1] = memb->item[0];
            if (y->type == 'P')
               memy->link = NULL;
            else
               memy ->link = copy_expr(memx->link);
            memy->next = NULL;
            if (y->first == NULL)
               y->first = memy;
            else
               y->last->next = memy;
            y->last = memy;
         }
      }
      erase_spar(x);
      return y;
}

/*----------------------------------------------------------------------
-- transpose - transpose sparse array.
--
-- This routine transposes the sparse array spar. It is assumed that
-- the list mute has the same dimension and the same mute letters as
-- the array spar. The routine permutes tuple entries for each array
-- element in order to place these entries in the new order which is
-- determined by the list mute. For example:
--
-- spar: i     j     k     mute: k j i     result: k     j     i
--       i1    j1    k1                            k1    j1    i1
--       i1    j2    k2                            k2    j2    i1
--       i2    j1    k2                            k2    j1    i2
--
-- Values assigned to elements of the array are not changed. */

void transpose(SPAR *spar, int mute[MAX_DIM])
{     MEMB *memb;
      ITEM *item[MAX_DIM];
      int k, t;
      for (memb = spar->first; memb != NULL; memb = memb->next)
      {  for (k = 0; k < spar->dim; k++)
            item[k] = memb->item[k];
         for (k = 0; k < spar->dim; k++)
         {  t = find_mute(spar->dim, spar->mute, mute[k]);
            insist(t >= 0);
            memb->item[k] = item[t];
         }
      }
      for (k = 0; k < spar->dim; k++) spar->mute[k] = mute[k];
      return;
}

/*----------------------------------------------------------------------
-- unary_op - perform unary arithmetic operation on sparse array.
--
-- This routine performs the unary arithmetic operation op on the
-- sparse array x and returns a pointer to resultant array. The input
-- array x is destroyed on exit. */

SPAR *unary_op(int op, SPAR *x)
{     if (x->type != 'X')
         fatal("invalid operand of unary arithmetic operation");
      if (op == C_POS)
         strcpy(x->name, "<unary plus>");
      else if (op == C_NEG)
      {  MEMB *memb;
         strcpy(x->name, "<unary minus>");
         for (memb = x->first; memb != NULL; memb = memb->next)
            memb->link = make_expr(op, memb->link, NULL);
      }
      return x;
}

/*----------------------------------------------------------------------
-- addition - perform additive operation on sparse arrays.
--
-- This routine performs additive operation on the sparse arrays x and
-- y and returns a pointer to the resultant array. Both input operands
-- x and y are destroyed on exit. */

SPAR *addition(int op, SPAR *x, SPAR *y)
{     SPAR *set[MAX_DIM];
      MEMB *memb, *temp;
      int dim, mute[MAX_DIM], k, t;
      if (!(x->type == 'X' && y->type == 'X'))
         fatal("invalid operand of binary arithmetic operation");
      /* determine dimension and domains of resultant array */
      dim = x->dim;
      for (k = 0; k < x->dim; k++)
      {  set[k] = x->set[k];
         mute[k] = x->mute[k];
      }
      for (k = 0; k < y->dim; k++)
      {  t = find_mute(dim, mute, y->mute[k]);
         if (t < 0)
         {  /* mute letter not found; new dimension is needed */
            if (dim == MAX_DIM)
               fatal("resultant dimension too high");
            set[dim] = y->set[k];
            mute[dim] = y->mute[k];
            dim++;
         }
         else
         {  /* both operands have the same mute letter, therefore the
               corresponding domains should be identical */
            if (set[t] != y->set[k])
               fatal("mute letter `%c' refers to different sets",
                  y->mute[k]);
         }
      }
      /* expand dimension of operands (if necessary) */
      for (k = 0; k < dim; k++)
      {  t = find_mute(x->dim, x->mute, mute[k]);
         if (t < 0) x = expand_spar(x, set[k], mute[k]);
         t = find_mute(y->dim, y->mute, mute[k]);
         if (t < 0) y = expand_spar(y, set[k], mute[k]);
      }
      insist(x->dim == dim && y->dim == dim);
      /* coordinate operands */
      transpose(x, mute);
      transpose(y, mute);
      /* now both operands have the same dimension and mute letters */
      switch (op)
      {  case C_ADD:
            strcpy(x->name, "<addition>");
            break;
         case C_SUB:
            strcpy(x->name, "<subtraction>");
            break;
         default:
            insist(op != op);
      }
      /* index elements of the first operand */
      create_index(x);
      for (memb = x->first; memb != NULL; memb = memb->next)
         index_memb(memb);
      /* x := x op y */
      while (y->first != NULL)
      {  memb = y->first;
         y->first = memb->next;
         temp = find_memb(memb->item);
         if (temp == NULL)
         {  /* member not found */
            if (op == C_SUB)
               memb->link = make_expr(C_NEG, memb->link, NULL);
            memb->next = NULL;
            if (x->first == NULL)
               x->first = memb;
            else
               x->last->next = memb;
            x->last = memb;
            index_memb(memb);
         }
         else
         {  /* member already exists */
            temp->link = make_expr(op, temp->link, memb->link);
            free_atom(pdb->memb_pool, memb);
         }
      }
      free_atom(pdb->spar_pool, y);
      delete_index();
      return x;
}

/*----------------------------------------------------------------------
-- multiplication - perform multiplicative operation on sparse arrays.
--
-- This routine performs multiplicative operation on the sparse arrays
-- x and y and returns a pointer to the resultant array. Both input
-- operands x and y are destroyed on exit. */

SPAR *multiplication(int op, SPAR *x, SPAR *y)
{     SPAR *z;
      MEMB *memx, *memy, *memb;
      ITEM *item[MAX_DIM];
      int k, t, tx, ty;
      if (!(x->type == 'X' && y->type == 'X'))
         fatal("invalid operand of binary arithmetic operation");
      /* create resultant array; determine its dimension and domains */
      z = get_atom(pdb->spar_pool);
      switch (op)
      {  case C_MUL:
            strcpy(z->name, "<multiplication>");
            break;
         case C_DIV:
            strcpy(z->name, "<division>");
            break;
         default:
            insist(op != op);
      }
      z->type = 'X';
      z->dim = x->dim;
      for (k = 0; k < x->dim; k++)
      {  z->set[k] = x->set[k];
         z->mute[k] = x->mute[k];
      }
      for (k = 0; k < y->dim; k++)
      {  t = find_mute(z->dim, z->mute, y->mute[k]);
         if (t < 0)
         {  /* mute letter not found; new dimension is needed */
            if (z->dim == MAX_DIM)
               fatal("resultant dimension too high");
            z->set[z->dim] = y->set[k];
            z->mute[z->dim] = y->mute[k];
            z->dim++;
         }
         else
         {  /* both operands have the same mute letter, therefore the
               corresponding domains should be identical */
            if (z->set[t] != y->set[k])
               fatal("mute letter `%c' refers to different sets",
                  y->mute[k]);
         }
      }
      z->first = z->last = NULL;
      /* z := x op y */
      for (memx = x->first; memx != NULL; memx = memx->next)
      {  for (memy = y->first; memy != NULL; memy = memy->next)
         {  /* build tuple of the resultant member */
            for (k = 0; k < z->dim; k++)
            {  tx = find_mute(x->dim, x->mute, z->mute[k]);
               ty = find_mute(y->dim, y->mute, z->mute[k]);
               if (tx >= 0 && ty >= 0)
               {  /* both operands have the same mute letter, therefore
                     the corresponding items should be identical */
                  if (memx->item[tx] != memy->item[ty]) goto miss;
               }
               if (tx >= 0)
                  item[k] = memx->item[tx];
               else if (ty >= 0)
                  item[k] = memy->item[ty];
               else
                  insist(k != k);
            }
            /* if both operands have no multiplets, there will be no
               multiplets in the resultant array */
            memb = get_atom(pdb->memb_pool);
            for (k = 0; k < z->dim; k++) memb->item[k] = item[k];
            memb->link = make_expr(op,
               copy_expr(memx->link), copy_expr(memy->link));
            memb->next = NULL;
            if (z->first == NULL)
               z->first = memb;
            else
               z->last->next = memb;
            z->last = memb;
miss:       ;
         }
      }
      erase_spar(x);
      erase_spar(y);
      return z;
}

/*----------------------------------------------------------------------
-- selection - perform predicate-controlled selection operation.
--
-- This routine performs selection operation on the sparse array x
-- using the predicate y as selection criterion and returns a pointer
-- to the resultant array. Both input operands x and y are destroyed on
-- exit. */

SPAR *selection(SPAR *x, SPAR *y)
{     MEMB *memb, *list;
      ITEM *item[MAX_DIM];
      int k, t;
      if (!(x->type == 'X' && y->type == 'P'))
         fatal("invalid operand of selection operation");
      /* all mute letters in the condition (the second operand) should
         be presented in the first operand */
      for (k = 0; k < y->dim; k++)
      {  t = find_mute(x->dim, x->mute, y->mute[k]);
         if (t < 0)
            fatal("mute letter `%c' ... missing", y->mute[k]);
         if (x->set[t] != y->set[k])
            fatal("mute letter `%c' refers to different sets",
               y->mute[k]);
      }
      /* index predicate members */
      create_index(y);
      for (memb = y->first; memb != NULL; memb = memb->next)
         index_memb(memb);
      /* select members of the first operand and build the resultant
         array */
      list = x->first;
      x->first = x->last = NULL;
      while (list != NULL)
      {  memb = list, list = memb->next;
         for (k = 0; k < y->dim; k++)
         {  t = find_mute(x->dim, x->mute, y->mute[k]);
            item[k] = memb->item[t];
         }
         if (find_memb(item) == NULL)
         {  erase_expr(memb->link);
            free_atom(pdb->memb_pool, memb);
         }
         else
         {  memb->next = NULL;
            if (x->first == NULL)
               x->first = memb;
            else
               x->last->next = memb;
            x->last = memb;
         }
      }
      delete_index();
      erase_spar(y);
      return x;
}

/*----------------------------------------------------------------------
-- comparison - perform arithmetic comparison of two sparse arrays.
--
-- This routine performs arithmetic comparison of the sparse arrays x
-- and y and returns a pointer to the resultant *predicate*. Both input
-- operands are destroyed on exit. */

SPAR *comparison(int op, SPAR *x, SPAR *y)
{     MEMB *memb, *temp;
      EXPR *expr;
      double val, cond;
      if (!(x->type == 'X' || y->type == 'X'))
err:     fatal("invalid operand of relation operation");
      /* each members of the first operand should be a constant model
         expression */
      for (memb = x->first; memb != NULL; memb = memb->next)
      {  expr = memb->link;
         insist(expr != NULL);
         if (!(expr->head->op == C_CON && expr->head->next == NULL))
            goto err;
      }
      /* the second operand should be scalar, the only member of which
         should be a constant expression */
      if (!(y->dim == 0 && y->first != NULL && y->first->next == NULL))
         goto err;
      expr = y->first->link;
      if (!(expr->head->op == C_CON && expr->head->next == NULL))
         goto err;
      val = expr->head->arg.con;
      /* x := x op y */
      switch (op)
      {  case C_LT:
            strcpy(x->name, "<less than>");
            break;
         case C_LE:
            strcpy(x->name, "<less than or equal to>");
            break;
         case C_EQ:
            strcpy(x->name, "<equal to>");
            break;
         case C_GE:
            strcpy(x->name, "<greater than or equal to>");
            break;
         case C_GT:
            strcpy(x->name, "<greater than>");
            break;
         case C_NE:
            strcpy(x->name, "<not equal to>");
            break;
         default:
            insist(op != op);
      }
      x->type = 'P'; /* result is a predicate */
      temp = x->first;
      x->first = x->last = NULL;
      while (temp != NULL)
      {  memb = temp;
         temp = memb->next;
         expr = memb->link;
         insist(expr != NULL);
         insist(expr->head->op == C_CON && expr->head->next == NULL);
         cond = eval_const(op, expr->head->arg.con, val);
         erase_expr(expr);
         memb->link = NULL;
         memb->next = NULL;
         if (cond == 0.0)
            free_atom(pdb->memb_pool, memb);
         else
         {  if (x->first == NULL)
               x->first = memb;
            else
               x->last->next = memb;
            x->last = memb;
         }
      }
      return x;
}

/*----------------------------------------------------------------------
-- logical_not - perform operation "not" on sparse predicate.
--
-- This routine performs operation "not" on the sparse predicate x and
-- returns a pointer to the resultant predicate. The input predicate x
-- is destroyed on exit. */

SPAR *logical_not(SPAR *x)
{     SPAR *z;
      ITEM *item[MAX_DIM];
      MEMB *ptr[MAX_DIM], *memb;
      int k, t;
      if (x->type != 'P')
         fatal("invalid operand of unary logical operation");
      /* create resultant predicate */
      z = get_atom(pdb->spar_pool);
      memcpy(z, x, sizeof(SPAR));
      strcpy(z->name, "<logical not>");
      z->first = z->last = NULL;
      /* initialize pointers to the first elements of index sets */
      for (k = 0; k < x->dim; k++)
      {  ptr[k] = x->set[k]->first;
         /* check if at least domain is empty */
         if (ptr[k] == NULL) goto skip;
      }
      /* index elements of the input predicate */
      create_index(x);
      for (memb = x->first; memb != NULL; memb = memb->next)
         index_memb(memb);
      /* generate all tuples of the cartesian product */
      for (;;)
      {  /* build the current tuple */
         for (k = 0; k < x->dim; k++)
            item[k] = ptr[k]->item[0];
         /* determine the next tuple */
         for (k = x->dim-1; k >= 0; k--)
         {  ptr[k] = ptr[k]->next;
            if (ptr[k] != NULL) break;
            ptr[k] = x->set[k]->first;
         }
         /* if the corresponding element is not in the predicate x,
            include it in the resultant predicate */
         if (find_memb(item) == NULL)
         {  memb = get_atom(pdb->memb_pool);
            for (t = 0; t < x->dim; t++)
               memb->item[t] = item[t];
            memb->link = NULL;
            memb->next = NULL;
            if (z->first == NULL)
               z->first = memb;
            else
               z->last->next = memb;
            z->last = memb;
         }
         /* check if the next tuple exists */
         if (k < 0) break;
      }
      delete_index();
skip: erase_spar(x);
      return z;
}

/*----------------------------------------------------------------------
-- logical_and - perform operation "and" on two sparse predicates.
--
-- This routine performs operation "and" on the sparse predicates x and
-- y and returns a pointer to the resultant predicate. The predicates x
-- and y are destroyed on exit. */

SPAR *logical_and(SPAR *x, SPAR *y)
{     SPAR *z;
      MEMB *memx, *memy, *memb;
      ITEM *item[MAX_DIM];
      int k, t, tx, ty;
      if (!(x->type == 'P' && y->type == 'P'))
         fatal("invalid operand of binary logical operation");
      /* create resultant predicate; determine its dimension and domain
         sets */
      z = get_atom(pdb->spar_pool);
      strcpy(z->name, "<logical and>");
      z->type = 'P';
      z->dim = x->dim;
      for (k = 0; k < x->dim; k++)
      {  z->set[k] = x->set[k];
         z->mute[k] = x->mute[k];
      }
      for (k = 0; k < y->dim; k++)
      {  t = find_mute(z->dim, z->mute, y->mute[k]);
         if (t < 0)
         {  /* mute letter not found; new dimension is needed */
            if (z->dim == MAX_DIM)
               fatal("resultant dimension too high");
            z->set[z->dim] = y->set[k];
            z->mute[z->dim] = y->mute[k];
            z->dim++;
         }
         else
         {  /* both operands have the same mute letter, therefore the
               corresponding domains should be identical */
            if (z->set[t] != y->set[k])
               fatal("mute letter `%c' refers to different sets",
                  y->mute[k]);
         }
      }
      z->first = z->last = NULL;
      /* z := x and y */
      for (memx = x->first; memx != NULL; memx = memx->next)
      {  for (memy = y->first; memy != NULL; memy = memy->next)
         {  /* build tuple of the resultant member */
            for (k = 0; k < z->dim; k++)
            {  tx = find_mute(x->dim, x->mute, z->mute[k]);
               ty = find_mute(y->dim, y->mute, z->mute[k]);
               if (tx >= 0 && ty >= 0)
               {  /* both operands have the same mute letter, therefore
                     the corresponding items should be identical */
                  if (memx->item[tx] != memy->item[ty]) goto miss;
               }
               if (tx >= 0)
                  item[k] = memx->item[tx];
               else if (ty >= 0)
                  item[k] = memy->item[ty];
               else
                  insist(k != k);
            }
            /* if both operands have no multiplets, there will be no
               multiplets in the resultant predicate */
            memb = get_atom(pdb->memb_pool);
            for (k = 0; k < z->dim; k++) memb->item[k] = item[k];
            memb->link = NULL;
            memb->next = NULL;
            if (z->first == NULL)
               z->first = memb;
            else
               z->last->next = memb;
            z->last = memb;
miss:       ;
         }
      }
      erase_spar(x);
      erase_spar(y);
      return z;
}

/*----------------------------------------------------------------------
-- logical_or - perform operation "or" on two sparse predicates.
--
-- This routine performs operation "or" on the sparse predicates x and
-- y and returns a pointer to the resultant predicate. The predicates x
-- and y are destroyed on exit. */

SPAR *logical_or(SPAR *x, SPAR *y)
{     SPAR *set[MAX_DIM];
      MEMB *memb, *temp;
      int dim, mute[MAX_DIM], k, t;
      if (!(x->type == 'P' && y->type == 'P'))
         fatal("invalid operand of binary logical operation");
      /* determine dimension and domains of resultant predicate */
      dim = x->dim;
      for (k = 0; k < x->dim; k++)
      {  set[k] = x->set[k];
         mute[k] = x->mute[k];
      }
      for (k = 0; k < y->dim; k++)
      {  t = find_mute(dim, mute, y->mute[k]);
         if (t < 0)
         {  /* mute letter not found; new dimension is needed */
            if (dim == MAX_DIM)
               fatal("resultant dimension too high");
            set[dim] = y->set[k];
            mute[dim] = y->mute[k];
            dim++;
         }
         else
         {  /* both operands have the same mute letter, therefore the
               corresponding domains should be identical */
            if (set[t] != y->set[k])
               fatal("mute letter `%c' refers to different sets",
                  y->mute[k]);
         }
      }
      /* expand dimension of operands (if necessary) */
      for (k = 0; k < dim; k++)
      {  t = find_mute(x->dim, x->mute, mute[k]);
         if (t < 0) x = expand_spar(x, set[k], mute[k]);
         t = find_mute(y->dim, y->mute, mute[k]);
         if (t < 0) y = expand_spar(y, set[k], mute[k]);
      }
      insist(x->dim == dim && y->dim == dim);
      /* coordinate operands */
      transpose(x, mute);
      transpose(y, mute);
      /* now both operands have the same dimension and mute letters */
      strcpy(x->name, "<logical or>");
      /* index elements of the first operand */
      create_index(x);
      for (memb = x->first; memb != NULL; memb = memb->next)
         index_memb(memb);
      /* x := x or y */
      while (y->first != NULL)
      {  memb = y->first;
         y->first = memb->next;
         temp = find_memb(memb->item);
         if (temp == NULL)
         {  /* member not found */
            memb->link = NULL;
            memb->next = NULL;
            if (x->first == NULL)
               x->first = memb;
            else
               x->last->next = memb;
            x->last = memb;
            index_memb(memb);
         }
         else
         {  /* member already exists */
            free_atom(pdb->memb_pool, memb);
         }
      }
      free_atom(pdb->spar_pool, y);
      delete_index();
      return x;
}

/*----------------------------------------------------------------------
-- summation - perform aggregate summation over given sets.
--
-- This routine performs aggregate summation of members of sparse array
-- x over the given sets specified by the corresponding mute letters and
-- returns a pointer to the resultant array. The array x is destroyed on
-- exit. */

SPAR *summation(SPAR *x, int n, int mute[MAX_DIM])
{     SPAR *z;
      ITEM *item[MAX_DIM];
      MEMB *memb, *temp;
      int k, t;
      if (x->type != 'X')
         fatal("invalid operand of arithmetic aggregate operation");
      /* all specified mute letters should be presented in x */
      for (k = 0; k < n; k++)
      {  t = find_mute(x->dim, x->mute, mute[k]);
         if (t < 0)
            fatal("mute letter `%c' missing in array operand", mute[k]);
      }
      /* create resultant array; determine its dimension and domains */
      z = get_atom(pdb->spar_pool);
      strcpy(z->name, "<sum>");
      z->type = 'X';
      z->dim = 0;
      for (k = 0; k < x->dim; k++)
      {  t = find_mute(n, mute, x->mute[k]);
         if (t < 0)
         {  /* mute letter not found; new dimension is needed */
            insist(z->dim < MAX_DIM);
            z->set[z->dim] = x->set[k];
            z->mute[z->dim] = x->mute[k];
            z->dim++;
         }
      }
      z->first = z->last = NULL;
      /* perform summation */
      create_index(z);
      while (x->first != NULL)
      {  memb = x->first;
         x->first = memb->next;
         /* determine tuple of the resultant member */
         for (k = 0; k < z->dim; k++)
         {  t = find_mute(x->dim, x->mute, z->mute[k]);
            insist(t >= 0);
            item[k] = memb->item[t];
         }
         temp = find_memb(item);
         if (temp == NULL)
         {  /* member not found */
            for (k = 0; k < z->dim; k++) memb->item[k] = item[k];
            memb->next = NULL;
            if (z->first == NULL)
               z->first = memb;
            else
               z->last->next = memb;
            z->last = memb;
            index_memb(memb);
         }
         else
         {  /* member already exists */
            temp->link = make_expr(C_ADD, temp->link, memb->link);
            free_atom(pdb->memb_pool, memb);
         }
      }
      delete_index();
      free_atom(pdb->spar_pool, x);
      return z;
}

/*----------------------------------------------------------------------
-- print_spar - print sparse array.
--
-- This routine prints the sparse array spar. If the flag temp is zero,
-- the array is assumed to be the named object. Otherwise, the array is
-- is assumed to be indermediate result. */

void print_spar(SPAR *spar, int temp)
{     MEMB *memb;
      int k;
      outstr(NULL);
      outstr("\n");
      switch (spar->type)
      {  case 'S': outstr("set");        break;
         case 'P': outstr("predicate");  break;
         case 'X': outstr("parameter");  break;
         case 'V': outstr("variable");   break;
         case 'C': outstr("constraint"); break;
         default: insist(spar->type != spar->type);
      }
      outstr(" ");
      outstr(temp ? "..." : spar->name);
      if (spar->dim > 0)
      {  outstr("[");
         for (k = 0; k < spar->dim; k++)
         {  if (k > 0) outstr(",");
            if (temp)
            {  char mute[2];
               mute[0] = (char)spar->mute[k], mute[1] = '\0';
               outstr(mute);
               outstr(" in ");
            }
            outstr(spar->set[k]->name);
         }
         outstr("]");
      }
      outstr("\n");
      if (spar->first == 0)
      {  outstr("object has no members");
         outstr("\n");
      }
      for (memb = spar->first; memb != NULL; memb = memb->next)
      {  if (!temp) outstr(spar->name);
         if (spar->dim > 0)
         {  outstr("[");
            for (k = 0; k < spar->dim; k++)
            {  if (k > 0) outstr(",");
               outstr(memb->item[k]->name);
            }
            outstr("]");
         }
         if (spar->type == 'X')
         {  outstr(" = ");
            print_expr(memb->link);
         }
         if (spar->type == 'C')
         {  outstr(" = ");
            print_expr(((CONS *)memb->link)->expr);
         }
         outstr("\n");
      }
      return;
}

/* eof */
