/****************************************************************************
**
*A  pretty_filterfns.c          ANUPQ source                   Eamonn O'Brien
**
*Y  Copyright 1995-2001,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
*Y  Copyright 1995-2001,  School of Mathematical Sciences, ANU,     Australia
**
*/

#include "pq_defs.h"
#include "pretty_filterfns.h"
#include "constants.h"

/* filter functions to process "pretty" presentation input;
   this code was written and supplied by Sarah Rees */

static void word_double(word *wp);
static void word2user_name(word *prog_wordp, word *user_wordp);

int num_gens = 0;
gen_type *inv_of = 0;
word *user_gen_name = 0;
int gen_array_size = 53;
int *pairnumber = 0;
int paired_gens;

void pc_word_init(word *wp)
{
   wp->g = anu_valloc(gen_type, 16);
   wp->first = 0;
   wp->last = -1;
   wp->space = 16;
   wp->type = 0; /* later set as 's' or 'c' */
   wp->n = 1; /* only one for trivial or unexpanded words. After initialisation
                 this is set to 0 if the word is not a proper power, and to the
                 power otherwise.
                 */
}

void word_init(word *wp)
{
   wp->g = anu_valloc(gen_type, 16);
   wp->first = 0;
   wp->last = -1;
   wp->space = 16;
   wp->type = 's';
   wp->n = 0;
}

/* Clear space allocated to a word.
The space assigned to a word (as a pointer to generators) is cleared.
*/
void word_clear(word *wp)
{
   free((char *)wp->g);
   wp->g = 0;
}

void pc_word_reset(word *wp)
{
   wp->last = wp->first - 1;
   wp->type = 0;
   wp->n = 1;
}

void word_reset(word *wp)
{
   wp->last = wp->first - 1;
}

/*
The word |*wp| has certainly been initialized, and may already contain a
non-trivial word. But the information it contains, if any, is redundant, and
can be thrown away. We just require the space for new information but there
may not be enough of it. If the word currently contains space for less than
n generators we increase the amount of space to this. We set the position
for the first word entry at a, and the last at a-1 (since at this stage the
word is empty).
*/
void word_stretch_reset(word *wp, int N, int a)
{
   if (wp->space < N) {
      free((char *)wp->g);
      wp->g = 0;
      wp->g = anu_valloc(gen_type, N);
      wp->space = N;
   }
   wp->first = a;
   wp->last = a - 1;
}


/* Initialize a |word_traverser| to make it traverse a particular
word, whose address is given in the second argument.
*/
static void word_traverser_init(word_traverser *wtp, word *wp)
{
   wtp->wp = wp;
   wtp->posn = wp->first;
}

word_link *word_link_create(void)
{
   word_link *wlp = anu_valloc(word_link, 1);
   wlp->wp = 0;
   wlp->next = 0;
   return wlp;
}

void word_link_init(word_link *wlp)
{
   wlp->wp = anu_valloc(word, 1);
   word_init(wlp->wp);
   wlp->next = word_link_create();
}

void word_link_clear(word_link *wlp)
{
   word_clear(wlp->wp);
   free((char *)(wlp->wp));
}


/* |word_get_first ()| gets hold of the first generator in a word without
changing it. It returns |1| provided the word is non-trivial, |0|
otherwise.
The  pointer |gp| is set to point to the first generator in the word pointed
to by |wp|.
*/
char word_get_first(word *wp, gen_type *gp)
{
   if (wp->first <= wp->last) {
      *gp = (wp->g)[wp->first];
      return 1;
   } else {
      *gp = 0;
      return 0;
   }
}

/* |word_next ()| is used when traversing a word, generator by generator. It
returns |1| while the |list_traverser| points to a generator, |0|
once the last generator in the word has been passed.
The  pointer |gp| is set to point to the generator at which the
|word_traverser| is currently positioned..
The procedure does not change the word being traversed.
*/
char word_next(word_traverser *wtp, gen_type *gp)
{
   if (wtp->posn <= wtp->wp->last) {
      *gp = (wtp->wp->g)[wtp->posn];
      wtp->posn++;
      return 1;
   } else {
      *gp = 0;
      return 0;
   }
}


/* Construct the inverse of a word.
If a word is read as a sequence of generators the inverse word consists of
the string of the inverses of these generators, but in the reverse order.
Before the function is applied |*inverse| could be a freshly initialized word or
an actual word already in use. It might be the same word as |*given|.
 Space is assigned or reassigned as necessary
within this function.
*/
void word_inv(word *given, word *inverse)
{
   int i;
   int j;
   gen_type *gp = 0;
   gp = anu_valloc(gen_type, given->space);
   for (i = given->first, j = given->last; i <= given->last; i++, j--)
      gp[i] = inv(given->g[j]);
   inverse->space = given->space;
   inverse->first = given->first;
   inverse->last = given->last;
   free((char *)inverse->g);
   inverse->g = 0;
   inverse->g = gp;
}

void word_put_last(word *wp, gen_type g)
{
   int i;
   int n;
   n = wp->space;
   if (wp->last == n - 1) { /* there's an entry in the rightmost
                               piece of space */
      if (wp->first > n / 2) {
         int k;
         k = n / 4;
         wp->first -= k;
         wp->last -= k;
         for (i = wp->first; i <= wp->last; ++i)
            wp->g[i] = wp->g[i + k];
      } else
         word_double(wp);
   }
   (wp->last)++;
   wp->g[wp->last] = g;
}

/*Adding on a generator to the left hand end of a word (left
multiplication).
*/
void word_put_first(word *wp, gen_type g)
{
   if (wp->first == 0) {
      int i;
      int n;
      n = wp->space;
      if (wp->last <= n / 2) {
         int k;
         k = n / 4;
         wp->first += k;
         wp->last += k;
         for (i = wp->last; i >= wp->first; --i)
            wp->g[i] = wp->g[i - k];
      } else
         word_double(wp);
   }
   (wp->first)--;
   wp->g[wp->first] = g;
}

/* Double the amount of space available to a word, while preserving the
information stored in the word.
*/
static void word_double(word *wp)
{
   int n;
   int k;
   int i;
   gen_type *gp;
   n = wp->space;
   k = n / 2;
   gp = anu_valloc(gen_type, 2 * n);
   for (i = k; i < 3 * k; ++i)
      gp[i] = (wp->g)[i - k];
   free((char *)wp->g);
   wp->g = 0;
   wp->g = gp;
   wp->space *= 2;
   wp->first += k;
   wp->last += k;
}

/*Get the first generator out of a word, and at the same time delete it from
that word.
The function returns |0| if the word is trivial, |1| otherwise.
*/
char word_delget_first(word *wp, gen_type *gp)
{
   if (wp->first > wp->last) {
      *gp = 0;
      return 0;
   } else {
      *gp = wp->g[wp->first++];
      return 1;
   }
}

/* Delete the last generator in a word.
The function returns |0| if the word is trivial, |1| otherwise.
*/
char word_del_last(word *wp)
{
   if (wp->first > wp->last)
      return 0;
   else {
      wp->last--;
      return 1;
   }
}

/* Concatenate two words.
|wp1|, |wp2| and |wp3| are pointers to initialized words. |*wp1| and |*wp2| are
not changed by this procedure (provided that they are both distinct from
|*wp3|). At the end |*wp3| contains the concatenation
of |*wp1| and |*wp2|.
*/
void word_concat(word *wp1, word *wp2, word *wp3)
{
   int n1, n2, n;
   int N;
   int i;
   gen_type *factor, *concat;

   n1 = word_length(wp1);
   n2 = word_length(wp2);
   n = n1 + n2;
   if (n <= 0) {
      wp3->last = wp3->first - 1;
      return;
   } /* avoid malloc()ing 0 bytes */
   concat = anu_valloc(gen_type, n);
   factor = wp1->g + wp1->first;
   for (i = 0; i < n1; i++)
      concat[i] = factor[i];
   factor = wp2->g + wp2->first;
   for (i = n1; i < n; i++)
      concat[i] = factor[i - n1];
   N = wp1->space > wp2->space ? wp1->space : wp2->space;
   while (N < 2 * n)
      N *= 2;
   word_stretch_reset(wp3, N, n / 2);
   for (i = 0; i < n; ++i)
      wp3->g[wp3->first + i] = concat[i];
   wp3->last = wp3->first + n - 1;
   free((char *)concat);
   concat = 0;
}

void word_append(word *wp1, word *wp2)
{
   int N = wp1->space;
   int last = wp1->last;
   int n2 = (wp2->last) - (wp2->first) + 1;
   int i;
   gen_type *genp1, *genp2, *genp3;
   while (N - 1 - last <= n2)
      N *= 2;
   if (N > wp1->space) {
      gen_type *genp = vzalloc(gen_type, N);
      for (i = wp1->first; i <= last; i++)
         genp[i] = (wp1->g)[i];
      free((char *)(wp1->g));
      wp1->g = genp;
      wp1->space = N;
   }
   genp1 = (wp1->g) + last;
   genp3 = genp1 + n2;
   genp2 = (wp2->g) + (wp2->first);
   while (++genp1 <= genp3)
      *genp1 = *(genp2++);
   wp1->last += n2;
}


char word_eq(word *w1p, word *w2p)
{
   int m;
   if ((m = ((w1p->last) - (w1p->first))) != ((w2p->last) - (w2p->first)))
      return 0;
   else if (m >= 0) {
      int i;
      gen_type *g1p = w1p->g + w1p->first;
      gen_type *g2p = w2p->g + w2p->first;
      for (i = 0; i <= m; i++)
         if (g1p[i] != g2p[i])
            return 0;
   }
   return 1;
}


void word_cpy(word *oldwp, word *newwp)
{
   int m;
   int n;
   int i;
   gen_type *newgp, *oldgp;

   newwp->type = oldwp->type;
   newwp->n = oldwp->n;

   m = word_length(oldwp);
   if ((n = newwp->space) < 2 * m) {
      while (n < 2 * m)
         n *= 2;
      free((char *)(newwp->g));
      newwp->g = 0;
      newwp->g = anu_valloc(gen_type, n);
      newwp->space = n;
   }
   newwp->first = m / 2;
   newwp->last = newwp->first + m - 1;
   newgp = newwp->g + newwp->first;
   oldgp = oldwp->g + oldwp->first;
   for (i = 0; i < m; ++i)
      newgp[i] = oldgp[i];
}

static void bad_data(void)
{
   fprintf(stderr, "Bad data.\n");
   exit(FAILURE);
}

char read_next_gen(word *wp, FILE *file)
{
   char ans = 1;
   int c;
   word_reset(wp);
   while ((c = read_char(file)) != EOF && !(isalpha(c))) {
      if (c == '$')
         return 1;
      if (c == '}') {
         /* a '}' is used to terminate the input of gens */
         ungetc('}', file);
         ans = 0;
         break;
      } else if (c != ' ' && c != ',') {
         fprintf(stderr, "Generators must start with a letter.\n");
         bad_data();
      }
   }
   if (c == EOF) {
      fprintf(stderr, "Unexpected end of file.\n");
      bad_data();
   }
   if (ans == 1) {
      do {
         if (c == EOF)
            break;
         if (c == '^') {
            int d, e;
            d = read_char(file);
            e = read_char(file);
            if (d != '-' || e != '1') {
               fprintf(stderr, "Invalid generator name.\n");
               bad_data();
            }
            word_put_last(wp, c);
            word_put_last(wp, d);
            word_put_last(wp, e);
            c = read_char(file);
            break;
         }

         if (!isalpha(c) && !isdigit(c) && c != '_' && c != '.') {
            fprintf(stderr,
                    "Only letters, digits, underscores and .'s are "
                    "allowed in generator names.\n");
            bad_data();
         }
         word_put_last(wp, c);
         c = read_char(file);
      } while (isalpha(c) || isdigit(c) || c == '^' || c == '-' || c == '_' ||
               c == '.');
      if (c != EOF && c != ' ')
         ungetc(c, file);
   }
   return ans;
}

char read_next_word(word *wp, FILE *file)
{
   /*
     A word is recognisable as a power of a single commutator iff
     a) the first symbol after any number of ('s is a [ and
     b) it contains no *'s, no ['s or ^'s inside the []'s, and only ('s, )'s ^'s
     -'s
     and digits outside.
     wp->type is initialised as 0, then we reset it
     when we encounter the first symbol that is not a (. If set to
     c it will be reset to s once an inappropriate symbol is encountered.
     is encountered .
     A word is recognised as a power if it contains no *'s
     unless enclosed by ()'s. wp->n is reset to 0 as soon
     as such a '*' is encountered.
     */
   char ans = 1;
   int c;
   word_reset(wp);
   while ((c = read_char(file)) != EOF && !(isalpha(c)) && !(isdigit(c)) &&
          c != '(' && c != '[') {
      if (c == '$')
         return 1;
      if (c == '}') {
         /* a '}' is used to terminate the input of words */
         ungetc('}', file);
         ans = 0;
         break;
      }
   }
   if (c == EOF) {
      fprintf(stderr, "Unexpected end of file.\n");
      bad_data();
   }
   if (ans == 1 && c == '1')
      return ans;
   /* 1 is used to represent the identity. It will only be the first symbol in a
      word when it's the whole word. */
   if (ans == 1) {
      char bracket_level = 0;
      char comm_level = 0;
      do {
         if (c == EOF)
            break;
         if (c == ' ' || (c == ',' && comm_level == 0)) {
            /* if this happens, the previous character must have been an
               alphanumeric character or a ), and we are not within commutators
               (since
               spaces after ^,( and * and inside commutators are dealt with
               elsewhere). If the next non-space character is not *,^ or ) we
               must have
               reached the end of the word. */
            do {
               c = read_char(file);
               if (c == EOF)
                  break;
            } while (c == ' ');
            if (c == EOF || (c != '^' && c != '*' && c != ']' && c != ')'))
               break; /* we have got to the end of the word */
         }
         if (c == '[') {
            comm_level++;
            if (wp->type != 0)
               wp->type = 's';
            if (wp->type == 0)
               wp->type = 'c';
         } else if (c == ']')
            comm_level--;
         else if (c == '(')
            bracket_level++;
         else if (c == ')')
            bracket_level--;
         if ((c == '*') || (wp->type == 0 && c != '(') ||
             (comm_level == 0 && c != ']' && c != '(' && c != ')' && c != '^' &&
              c != '-' && (!isdigit(c))))
            wp->type = 's';
         if (bracket_level == 0 && comm_level == 0 && c == '*')
            wp->n = 0;
         if (bracket_level >= 0 && comm_level >= 0)
            word_put_last(wp, c);
         else
            break;
         /* word reading is terminated by an unmatched right bracket of either
          * type */
         if (c == '*' || c == '^' || c == '(' || comm_level != 0) {
            /* '*','^' and '(' are non-terminal characters, so we can
               automatically
               skip over any
               white spaces that appear after them, without further
               investigation */
            do {
               c = read_char(file);
               if (c == EOF)
                  break;
            } while (c == ' ');
         } else {
            c = read_char(file);
            if (c == EOF)
               break;
         }
      } while (isalpha(c) || isdigit(c) || c == '_' || c == '.' || c == '^' ||
               c == '-' || c == '(' || c == ')' || c == '[' || c == ']' ||
               c == ',' || c == '*' || c == ' ');
      if (c != EOF)
         ungetc(c, file);
   }
   if (c == EOF) {
      fprintf(stderr, "Unexpected end of file.\n");
      bad_data();
   } else if (word_length(wp) == 0)
      wp->type = 's'; /* then we'd have the trivial word */
   else
      word_expand(wp);
   return ans;
}

void word_expand(word *wp)
{
   word expansion;
   word buf;
   word temp;
   word temp2;
   gen_type g;
   char type = wp->type;
   int n = wp->n;
   int separator = '*';
   int bracket_level = 0;
   int commutator_level = 0;
   int exponent;
   int sign = 1;
   if (type == 'c') {
      if (n) {
         int i = wp->first; /* i is the position we're currently at in gp */
         gen_type *gp = wp->g + wp->first;
         gen_type *ggp = wp->g + wp->last;
         while (gp <= ggp) {
            if ((*gp) == '^') {
               int j = i;
               exponent = 0;
               gp++;
               i++;
               if ((*gp) == '-')
                  sign = -1;
               else
                  exponent = (*gp) - '0';
               gp++;
               i++;
               while (gp <= ggp && isdigit(*gp)) {
                  exponent = 10 * exponent + (*gp) - '0';
                  gp++;
                  i++;
               }
               exponent *= sign;
               if (commutator_level == 0) {
                  /* in the case the whole commutator is raised to a power */
                  wp->last =
                      j - 1; /* this is to delete the exponent from the end */
                  if (exponent == 0)
                     word_reset(wp);
                  else
                     n *= exponent;
                  break;
               } else if (exponent != -1) {
                  /* if we see any exponent other than a -1 inside a commutator
                   * we expand it */
                  wp->type = type = 's';
                  break;
               }
            } else {
               if ((*gp) == '[')
                  commutator_level = 1;
               else if ((*gp) == ']')
                  commutator_level = 0;
               gp++;
               i++;
            }
         }
         wp->n = n;
      }
      if (wp->type == 'c')
         return;
   }
   word_init(&expansion);
   word_init(&buf);
   word_init(&temp);
   word_init(&temp2);
   while (word_delget_first(wp, &g)) {
      if (isalpha(g) || isdigit(g) || g == '_' || g == '.')
         word_put_last(&buf, g);
      else if (g == separator) {
         if (word_length(&buf) > 0) {
            word_append(&expansion, &buf);
            word_put_last(&expansion, g);
            word_reset(&buf);
         }
      } else if (g == '^') {
         /*  read the exponent that follows and replace whatever's currently in
             the buf by the appropriate number of copies of it or its inverse */
         int i;
         sign = 1;
         (void)word_delget_first(wp, &g);
         if (g == '-') {
            sign = -1;
            word_delget_first(wp, &g);
         }
         if (isdigit(g)) {
            exponent = 0;
            /*Now g must be a digit */
            exponent = g - '0' + 10 * exponent;
            while (word_get_first(wp, &g) && isdigit(g)) {
               exponent = g - '0' + 10 * exponent;
               word_delget_first(wp, &g);
            }
            if ((n) && word_length(wp) == 0) {
               /* wp->n non-zero means we believe we're looking for a power at
                  the end of
                  the word. We know we are at the end of the word if we've
                  deleted every character */
               if (exponent == 0)
                  word_reset(wp);
               else
                  n = sign * exponent;
            } else {
               if (sign == -1) {
                  gen_type h;
                  word2prog_word(&buf, &temp);
                  if (word_length(&temp) == 1 && word_get_last(&temp, &h) &&
                      (inv_of == 0 || inv_of[h] == 0)) {
                     /* in this case we're reading the name of a new generator
                      */
                     word_put_last(&buf, '^');
                     word_put_last(&buf, '-');
                     word_put_last(&buf, '1');
                  } else {
                     word_inv(&temp, &temp);
                     word2user_name(&temp, &buf);
                  }
               }
               word_cpy(&buf, &temp);
               word_reset(&buf);
               for (i = 1; i <= exponent; i++) {
                  word_append(&buf, &temp);
                  if (i < exponent && word_length(&buf) > 0)
                     word_put_last(&buf, separator);
               }
               word_reset(&temp);
            }
         } else {
            word exp;
            bracket_level = 0;
            commutator_level = 0;
            word_init(&exp);
            do {
               if (commutator_level == 0 && bracket_level == 0 &&
                   (g == '*' || g == '^')) {
                  word_put_first(wp, g);
                  break;
               }
               if (g == '(')
                  bracket_level++;
               else if (g == ')')
                  bracket_level--;
               if (g == '[')
                  commutator_level++;
               else if (g == ']')
                  commutator_level--;
               word_put_last(&exp, g);
            } while (word_delget_first(wp, &g));
            word_expand(&exp);
            if (word_length(&exp) > 0) {
               word2prog_word(&exp, &temp);
               word_inv(&temp, &temp);
               word2user_name(&temp, &temp2);
               word_put_last(&temp2, separator);
               word_concat(&temp2, &buf, &buf);
               word_put_last(&buf, separator);
               word_append(&buf, &exp);
               word_reset(&temp);
               word_reset(&temp2);
            }
            word_clear(&exp);
         }
      } else if (g == '(') {
         bracket_level = 1;
         while (word_delget_first(wp, &g)) {
            if (g == '(')
               bracket_level++;
            else if (g == ')')
               bracket_level--;
            if (bracket_level == 0)
               break;
            word_put_last(&buf, g);
         }
         word_expand(&buf);
      } else if (g == '[') {
         word w1, w2;
         commutator_level = 1;
         word_init(&w1);
         while (word_delget_first(wp, &g)) {
            if (g == ',' && commutator_level == 1)
               break;
            else if (g == '[')
               commutator_level++;
            else if (g == ']')
               commutator_level--;
            word_put_last(&w1, g);
         }
         word_expand(&w1);
         word_init(&w2);
         while (word_delget_first(wp, &g)) {
            if (g == '[')
               commutator_level++;
            else if (g == ',' && commutator_level == 1) {
               /* convert to nested binary commutators, to make expansion easier
                */
               word_put_first(&w1, '[');
               word_put_last(&w1, ',');
               word_append(&w1, &w2);
               word_put_last(&w1, ']');
               word_expand(&w1);
               word_reset(&w2);
               continue; /* we don't want to put the ',' onto the end of w2 */
            } else if (g == ']') {
               commutator_level--;
               if (commutator_level == 0)
                  break;
            }
            word_put_last(&w2, g);
         }
         word_expand(&w2);
         if (word_length(&w1) > 0 && word_length(&w2) > 0) {
            word2prog_word(&w1, &temp);
            word_inv(&temp, &temp);
            word2user_name(&temp, &buf);
            word_put_last(&buf, separator);
            word2prog_word(&w2, &temp);
            word_inv(&temp, &temp);
            word2user_name(&temp, &temp2);
            word_append(&buf, &temp2);
            word_put_last(&buf, separator);
            word_append(&buf, &w1);
            word_put_last(&buf, separator);
            word_append(&buf, &w2);
            word_reset(&temp);
            word_reset(&temp2);
         }
         word_clear(&w1);
         word_clear(&w2);
      }
   }
   if (bracket_level != 0 || commutator_level != 0) {
      fprintf(stderr, "Unmatched bracket in relation.\n");
      bad_data();
   }
   word_append(&expansion, &buf);
   /* there's no * at the end */
   if (word_get_last(&expansion, &g) && g == separator)
      word_del_last(&expansion);
   word_cpy(&expansion, wp);
   word_clear(&expansion);
   word_clear(&temp);
   word_clear(&temp2);
   word_clear(&buf);
   if (n == 1)
      wp->n = 0;
   else
      wp->n = n;
   wp->type = type;
}

char word_get_last(word *wp, gen_type *gp)
{
   char ans = 1;
   if (wp->first > wp->last) {
      *gp = 0;
      ans = 0;
   } else
      *gp = wp->g[wp->last];
   return ans;
}

char word_delget_last(word *wp, gen_type *gp)
{
   char ans = 1;
   if (wp->first > wp->last) {
      *gp = 0;
      ans = 0;
   } else {
      *gp = wp->g[wp->last];
      wp->last--;
   }
   return ans;
}


void word2prog_gen(word *user_namep, gen_type *prog_genp)
{

   gen_type g;

   *prog_genp = 0;
   for (g = 1; g <= num_gens; ++g)
      if (word_eq(user_namep, user_gen_name + g)) {
         *prog_genp = g;
         break;
      }
}

void word2prog_word(word *user_wordp, word *prog_wordp)
{
   word user_gen;
   word_traverser wt;
   gen_type g;
   gen_type h;
   int i;
   int n = word_length(user_wordp);
   char *epsilon = "epsilon";
   word identity;
   word_init(&identity);
   for (i = 0; i <= 6; i++)
      word_put_last(&identity, (gen_type)epsilon[i]);
   i = 0;
   word_reset(prog_wordp);
   prog_wordp->type = user_wordp->type;
   prog_wordp->n = user_wordp->n;
   if (word_eq(user_wordp, &identity) == 0) {
      word_init(&user_gen);
      word_traverser_init(&wt, user_wordp);
      while (word_next(&wt, &g)) {
         i++;
         if (g != '*' && g != ',' && g != '[' && g != ']' && g != '(' &&
             g != ')')
            word_put_last(&user_gen, g);
         if ((g == '*' || g == ',' || g == ']' || g == ')' || i == n) &&
             word_length(&user_gen) != 0) {
            word2prog_gen(&user_gen, &h);
            word_reset(&user_gen);
            word_put_last(prog_wordp, h);
         }
      }
      word_clear(&user_gen);
   }
   word_clear(&identity);
}

void gen2prog_gen(gen_type user_gen, gen_type *prog_genp)
{
   word w;
   word_init(&w);
   word_put_last(&w, user_gen);
   word2prog_gen(&w, prog_genp);
   word_clear(&w);
}


void gen2user_name(gen_type program_gen, word *user_wordp)
{

   word_reset(user_wordp);
   if (program_gen == 0 || (num_gens != 0 && program_gen > num_gens)) {
      gen_type g = '$';
      word_put_last(user_wordp, g);
   } else
      word_cpy(user_gen_name + program_gen, user_wordp);
}

static void word2user_name(word *prog_wordp, word *user_wordp)
{
   word w;
   gen_type separator;
   gen_type g = 0;
   word_traverser wt;
   word_traverser_init(&wt, prog_wordp);
   word_reset(user_wordp);
   word_init(&w);
   user_wordp->n = prog_wordp->n;
   user_wordp->type = prog_wordp->type;
   if (user_wordp->type == 'c') {
      word_put_first(user_wordp, '[');
      separator = ',';
   } else
      separator = '*';
   while (word_next(&wt, &g)) {
      gen2user_name(g, &w);
      word_append(user_wordp, &w);
      word_put_last(user_wordp, separator);
      word_reset(&w);
   }
   word_del_last(user_wordp); /* delete the final separator */
   if (user_wordp->type == 'c')
      word_put_last(user_wordp, ']');
   word_clear(&w);
}

static void define_next_gen(word *wp)
{
   word *ucpy;
   num_gens++;
   if (num_gens == gen_array_size - 1) {
      /* need more space */
      int i;
      gen_array_size = 2 * num_gens + 1;
      ucpy = vzalloc(word, gen_array_size);
      for (i = 0; i < gen_array_size; ++i)
         word_init(ucpy + i);
      for (i = 0; i < num_gens; ++i) {
         word_cpy(user_gen_name + i, ucpy + i);
         word_clear(user_gen_name + i);
      }
      free((char *)user_gen_name);
      user_gen_name = 0;
      user_gen_name = ucpy;
      ucpy = 0;
   }
   word_cpy(wp, user_gen_name + num_gens);
}

void read_gen_name_array(FILE *file)
{
   word w;
   int i;
   num_gens = 0;
   user_gen_name = vzalloc(word, gen_array_size);
   for (i = 0; i < gen_array_size; ++i)
      word_init(user_gen_name + i);
   find_char('{', file);
   word_init(&w);
   while (read_next_gen(&w, file)) {
      define_next_gen(&w);
      word_reset(&w);
   }
   word_clear(&w);
   find_char('}', file);
}

void insert_gen(gen_type h, word *wp)
{
   word *ucpy;
   gen_type *icpy;
   int i;
   int size = gen_array_size;
   num_gens++;
   if (num_gens == gen_array_size - 1)
      /* need more space */
      gen_array_size = 2 * num_gens + 1;
   ucpy = vzalloc(word, gen_array_size);
   icpy = vzalloc(gen_type, gen_array_size);
   for (i = 0; i < gen_array_size; ++i)
      word_init(ucpy + i);
   for (i = 0; i < h; ++i) {
      word_cpy(user_gen_name + i, ucpy + i);
   }
   word_cpy(wp, ucpy + h);
   for (i = h; i <= num_gens - 1; ++i)
      word_cpy(user_gen_name + i, ucpy + i + 1);
   for (i = 0; i < size; ++i)
      word_clear(user_gen_name + i);
   free((char *)user_gen_name);
   user_gen_name = 0;
   user_gen_name = ucpy;
   ucpy = 0;
   for (i = 0; i < h; ++i) {
      if (inv_of[i] >= h)
         icpy[i] = inv_of[i] + 1;
      else
         icpy[i] = inv_of[i];
   }
   for (i = h; i < num_gens; i++) {
      if (inv_of[i] >= h)
         icpy[i + 1] = inv_of[i] + 1;
      else
         icpy[i + 1] = inv_of[i];
   }
   free((char *)inv_of);
   inv_of = icpy;
   icpy = 0;
}


void default_inverse_array(void)
{
   word w;
   word_traverser wt;
   gen_type g, h, k;
   gen_type l = 0;
   if (inv_of == 0)
      inv_of = vzalloc(gen_type, gen_array_size);
   word_init(&w);
   for (g = 1; g <= num_gens; ++g) {
      if (inv_of[g] != 0)
         continue;
      /* we may have set some inverses already explicitly */
      if (word_length(user_gen_name + g) == 1) {
         /* we're just checking here to see that the user hasn't assumed the old
            default of case change. Therefore if the lower and upper case
            versions of
            the same character appear, the program exits with a bad data
            message. */
         word_get_first(user_gen_name + g, &h);
         if (islower(h))
            k = toupper(h);
         else
            k = tolower(h);
         gen2prog_gen(k, &l);
         if (l != 0) {
            /* h and k are lower and upper case versions of the same alphabet
               character.
               We don't allow this unless the generators are inverse to each
               other. This
               isn't the case here. */
            fprintf(
                stderr, "%c and %c aren't allowed as generator names\n", h, k);
            fprintf(stderr,
                    "unless they're defined to be inverse to each other.\n");
            bad_data();
         }
      }
      /* now we'll set the inverse of g appropriately */
      word_traverser_init(&wt, user_gen_name + g);
      while (word_next(&wt, &h)) {
         if (h == '^')
            break;
         else
            word_put_last(&w, h);
      }
      if (h != '^') {
         word_put_last(&w, '^');
         word_put_last(&w, '-');
         word_put_last(&w, '1');
      }
      word2prog_gen(&w, &k);
      if (k == 0) {
         /* There's no generator yet defined with user name w, so we have to
            slot one
            in, just after g.  */
         insert_gen(g + 1, &w);
         k = g + 1;
      }
      inv_of[g] = k;
      inv_of[k] = g;
      word_reset(&w);
   }
   word_clear(&w);
}


void word_factor(word *wp, word *wwp, int *ep)
{
   int length = word_length(wp);
   int baselength = 0;
   word power;
   word_init(&power);
   word_reset(wwp);
   if (length == 0) {
      *ep = 0;
      return;
   }
   while (baselength <= length) {
      word_traverser wt;
      int count = 0;
      gen_type g;
      int i;
      word_traverser_init(&wt, wp);
      while (word_next(&wt, &g)) {
         count++;
         if (count <= baselength)
            continue;
         word_put_last(wwp, g);
         baselength++;
         if (baselength > length / 2 || length % baselength == 0)
            break;
      }
      if (baselength > length / 2) {
         baselength = length;
         *ep = 1;
         break;
      } else {
         *ep = length / baselength;
         for (i = 1; i <= *ep; i++)
            word_append(&power, wwp);
         if (word_eq(wp, &power))
            break;
      }
      word_reset(&power);
   }
   word_clear(&power);
   if (baselength == length)
      word_cpy(wp, wwp);
}

char read_next_int(int *kp, FILE *rfile)
{
   char ans = 1;
   int sign = 1;
   int c;
   *kp = 0;
   while ((c = read_char(rfile)) != EOF && !(isdigit(c))) {
      if (c == '-')
         sign = -1;
      else if (c == '}' || c == ';') {
         /* a '}' or ';' is used to terminate the input */
         ungetc(c, rfile);
         ans = 0;
         break;
      } else
         sign = 1;
   }
   if (c == EOF)
      bad_data();
   if (ans == 1) {
      do {
         *kp = 10 * (*kp) + c - '0';
      } while (isdigit(c = getc(rfile)));
      ungetc(c, rfile);
   }
   *kp = sign * (*kp);
   return ans;
}

/* The next complete string is read and the first n or less  non-null characters
are
stored in cp. Any space between the last non-null character of the string
and
 the terminating null character of cp is filled
with blank spaces.  Spaces, tabs and
returns, and also matched pairs {} (and all the stuff between them) are skipped
over until other symbols are met. The string is terminated by a tab, space,
return , (,), { or } (which remains unread ).
A string beginning with } or  ;  causes the function to stop
reading and return false.  The character is then returned to the buffer as if
unread.
*/
char read_next_string(char *cp, int n, FILE *rfile)
{
   int i = 0;
   int c;
   char ans = 1;
   while ((c = read_char(rfile)) != EOF) {
      if (i == 0) {
         if (c == '}' || c == ';') {
            ungetc(c, rfile);
            return 0;
         } else if (c == '{') { /* skip over {}'s */
            int count = 1;
            while (count > 0) {
               if ((c = read_char(rfile)) == '{')
                  count++;
               else if (c == '}')
                  count--;
               if (c == EOF)
                  break;
            }
         } else if (c == ' ')
            continue;
         else {
            cp[0] = c;
            i = 1;
         }
      } else if (i > 0) {
         if (c == ' ' || c == ';' || c == '{' || c == '}' || c == '(' ||
             c == ')' || c == '=') {
            if (c != ' ')
               ungetc(c, rfile);
            break;
         } else {
            if (i < n)
               cp[i++] = c;
         }
      }
   }
   if (c == EOF) {
      ans = 0;
      i = 0; /* if the function's returning false, we'd like to empty the
                string */
   }
   while (i < n)
      cp[i++] = ' ';
   cp[n] = '\0';
   return ans;
}


char find_keyword(char *label, FILE *rfile)
{
   char *string;
   char found = 1;
   int k = 0;
   while (label[k] != '\0')
      k++;
   string = vzalloc(char, k + 1);
   do {
      found = 1;
      if (read_next_string(string, k, rfile) == 0) {
         found = 0;
         break;
      }
   } while ((strcmp(string, label) != 0));
   free(string);
   string = 0;
   return found;
}

/* The next function should be used in place of getc. It reads and returns
the next character, except that comments (preceded by # and going to the
next new line) and tabs and new lines are replaced by a single space.
*/
int read_char(FILE *rfile)
{
   int n;
   n = getc(rfile);
   /* The input may contain a '\' character which is printed before '\n'
      -- this is particularly true if the input file is generated by GAP */
   if (n == '\\') {
      n = getc(rfile);
      if (n == '\n')
         n = getc(rfile);
   }
   if (n == '#')
      while ((n = getc(rfile)) != '\n' && n != EOF)
         ;
   if (n == '\n' || n == '\t')
      return (' ');
   return (n);
}

void find_char(char c, FILE *rfile)
{
   int n;
   while ((n = read_char(rfile)) != c) {
      if (n == EOF) {
         fprintf(stderr, "Unexpected end of file.\n");
         bad_data();
      }
   }
   return;
}
