/***********************************
  (C) Copyright 1992-1993; dit/upm
  Distributed under the conditions stated in the
  TOPO General Public License (see file LICENSE)
 ***********************************
  $Log: elib.c,v $
 * Revision 1.22 2000/08/30 KJT
 * string lengths for "ordecs" increased by 1 to allow for newline
 *
 * Revision 1.21  1993/04/29  09:24:20  lotos
 * tratamiento de nuevas anotaciones
 * generacion de numero de linea en la ATable
 *
 * Revision 1.20  1993/01/25  14:01:19  lotos
 * fix bug in semiflattening
 *
 * Revision 1.19  1993/01/18  18:09:04  lotos
 * distribution issues
 *
 * Revision 1.18  1993/01/12  20:19:19  lotos
 * portability issues
 *
 * Revision 1.17  1992/12/17  11:21:16  lotos
 * portability to PC
 *
 * Revision 1.16  1992/11/04  16:17:33  lotos
 * option -C to compact sorts and operations unique identifiers
 * when a data type in incorrectly declared, it is assumed to have no formal part
 *
 * Revision 1.15  1992/08/31  17:50:53  lotos
 * non-formal entities cannot be referenced in the formal section of an ADT
 * minimal binding of value expressions
 *
 * Revision 1.14  92/08/31  17:43:52  lotos
 * correct actualization of variable-unique-identifier
 *
 * Revision 1.13  92/05/07  21:11:47  lotos
 * fix components of data types that are flattened
 *
 * Revision 1.12  92/05/06  17:34:33  lotos
 * bug fixed in data type lists
 * (identifier lists)
 *
 * Revision 1.11  92/03/13  19:57:43  lotos
 * bug fix for CR generation
 *
 * Revision 1.10  92/03/11  18:41:28  lotos
 * bug fixed
 *
 * Revision 1.9  92/02/29  13:22:20  lotos
 * minor bug fixing
 *
 * Revision 1.8  92/02/21  17:13:33  lotos
 * optimization of lists of operations, for speed up
 *
 * Revision 1.7  92/02/20  19:23:31  lotos
 * adjust scope passed to local definitions: gates and values
 *
 * Revision 1.6  92/01/30  18:09:08  lotos
 * outmost scope fixed
 * fix data types traversing for flattening
 *
 * Revision 1.5  92/01/22  20:00:06  lotos
 * fixed bug w.r.t. [semi]flattening functions
 *
 * Revision 1.4  92/01/14  15:23:35  lotos
 * distribution issues
 *
 * Revision 1.3  92/01/14  10:02:38  lotos
 * cosmetics
 *
 * Revision 1.2  92/01/13  16:26:39  lotos
 * thousands of small bugs
 *
 * Revision 1.1  92/01/07  16:05:50  lotos
 * Initial revision
 *
 ***********************************/

#ifndef lint
static char rcsid[]= "$Id: elib.c,v 1.21 1993/04/29 09:24:20 lotos Exp $";
#endif

# include "swbus.h"
# include "grc.h"

/*****  private types  *****/

/*****  private variables  *****/
PRIVATE int grntype_identifier [] ={ _type_identifier_1, 0};
PRIVATE int grntype_union []      ={ _type_union_1, 0};
PRIVATE int grnp_expression []    ={ _p_expression_1, 0};

/*****  private functions headers  *****/

PRIVATE int cmptree ();

/*****  private function bodies  *****/
PRIVATE TNexp*  freenexp= NULL;
PRIVATE INTlist freelist= NULL;
PRIVATE int*    procesed= NULL;
PRIVATE int     tproc=0;
# define BUCKSIZE 256
# define UNDEFFORMAL -1
# define ISFORMAL     1
# define NOFORMAL     2
# define WORKING     -2

# define COMPL 1
# define NOCOMPL 2

/* KJT 20/01/23: added function prototypes */
PUBLIC int isformal (TNODE* type);

PRIVATE INTlist
newil ()
{
  INTlist slot;
  INTlist buck;
  int i;

  if (freelist == NULL) {
    buck= (INTlist) malloc (BUCKSIZE * sizeof (struct IL));
    if (buck == NULL){
      (void) fprintf (stderr,"lsa: not enough memory\n");
      exit (1);
    }
    for (i= 0; i < BUCKSIZE; i++)
      buck[i].next= &buck[i+1];
    freelist= buck;
    buck[BUCKSIZE-1].next= NULL;
  }
  slot= freelist;
  freelist= freelist->next;
  slot->next= NULL;
  slot->cnt= 0;
  return slot;
}

PRIVATE int
isfact (type)
	TNODE*  type;
{
  TNODE* tpexp;
  TNODE* tunion;
  TNODE* aux;
  int    tid;

  tpexp = gt_rb(gt_fs(type));
  tunion = gt_rb(gt_fs(tpexp));

  for (aux = gt_fs(tunion); aux != NULL; aux = gt_rb(aux)){
    tid= (int)fdclr(c_idref,aux,1000+__LINE__);
    if (tid > 0){
      if (isformal((TNODE*)ATfind(ATable, tid,c_addr)->value))
	return TRUE;
    } else
	return TRUE;
  }
  return FALSE;
}

PRIVATE int
isfren (type)
	TNODE*	type;
{
  TNODE* tpexp;
  int	 tid;

  tpexp = gt_rb(gt_fs(type));

  tid= (int)fdclr(c_idref,gt_fs(tpexp),1000+__LINE__);
  if (tid > 0)
    return isformal((TNODE*)ATfind(ATable,tid,c_addr)->value);
  else
    return TRUE;
}

PRIVATE int
isfun (type)
	TNODE*	type;
{
  TNODE* tpexp;
  TNODE* tpspe;
  TNODE* tunion;
  TNODE* aux;
  int    tid;

  tpexp = gt_rb(gt_fs(type));
  tpspe = gt_fs(tpexp);
  if (tpspe -> type == ttype_union)
    tpspe = gt_rb (tpspe);

  for (aux = gt_fs (tpspe); aux != NULL; aux = gt_rb(aux))
    if ((aux->type == tformal_sorts) || (aux->type == tformal_operations))
      return TRUE;

  tunion = gt_fs (tpexp);
  if (tunion->type == ttype_union){
    for (aux = gt_fs(tunion); aux != NULL; aux = gt_rb(aux)){
      tid= (int)fdclr(c_idref,aux,1000+__LINE__);
      if ((tid > 0) && (isformal((TNODE*)ATfind(ATable, tid,c_addr)->value)))
	  return TRUE;
    }
  }else
    return FALSE;

  return FALSE;
}

PRIVATE int
isfirst (op1, op2, node)
	int	op1;
	int	op2;
	TNODE*	node;
{
  INTlist ar1;
  INTlist ar2;
  INTlist poss;
  TNODE*  auxnode;
  int     res=0;
  int     nres=0;
  int     scpcount=0;
  int     op1count=0;
  int     op2count=0;
  int	  opar1;
  int	  opar2;
  int     isf;

  if ((auxnode = gt_fs(node)) != NULL){
    ar1=(INTlist)ATfind (ATable,op1,c_argl)->value;
    ar2=(INTlist)ATfind (ATable,op2,c_argl)->value;
    for ( ;
	  ar1!=NULL;
	  ar1=INTtail(ar1), ar2=INTtail(ar2), auxnode=gt_rb(auxnode)){
      poss =(INTlist) find_attr (c_poss,auxnode)->value;
      for (scpcount = 0,op1count=0, op2count=0, nres =0;
	   poss != NULL;
	   poss = INTtail (poss)){
	if (INThead (poss)== -1){
	  scpcount++;
	} else {
	  if ((int)ATfind(ATable,INThead(poss),c_sort)->value==INThead (ar1)){
	    if (op2count != 0){
	      if (op2count < scpcount)
		return 2;
	      if (op2count == scpcount){
		isf = isfirst (INThead(poss), opar2, auxnode);
		if (isf == -1) return -1;
		if (isf == 2) return 2;
		if (isf == 1) nres = 1;
		if (isf == 0) nres = 0;
	      }
	    } else {
	      op1count=scpcount;
	      opar1 = INThead (poss);
	    }
	  }
	  if ((int)ATfind(ATable,INThead(poss),c_sort)->value==INThead (ar2)){
	    if (op1count != 0){
	      if (op1count < scpcount) {
		isf = isfirst (opar1, INThead(poss),auxnode);
		if (isf == -1) return -1;
		if (isf == 2) return 2;
		if (isf == 1) nres = 1;
		if (isf == 0) nres = 1;
	      } else
		break;
	    } else {
	      op2count=scpcount;
	      opar2 = INThead (poss);
	    }
	  }
	}
      }
      if ((res == 0) || (res == nres))
	res = nres;
      else
	return UNRES;
    }
  }

  return res;
}

PRIVATE int
ispos (next, type)
	TNODE*  next;
	int     type;
{
assert (next != NULL);

switch (type) {
  case tformal_sorts :
    switch (next->type) {
      case tformal_operations :
      case tformal_equations :
      case tsorts :
      case toperations :
      case tequations :
	    return TRUE;
    }
  case tformal_operations :
    switch (next->type) {
      case tformal_equations :
      case tsorts :
      case toperations :
      case tequations :
	    return TRUE;
    }
  case tformal_equations :
    switch (next->type) {
      case tsorts :
      case toperations :
      case tequations :
	    return TRUE;
    }
  case tsorts :
    switch (next->type) {
      case toperations :
      case tequations :
	    return TRUE;
    }
  case toperations :
    switch (next->type) {
      case tequations :
	    return TRUE;
    }
  /* case tequations :*/
}
return FALSE;

}
/* PUBLIC FUNCTIONS */

PUBLIC INTlist
mgetINTlist (fp)
     FILE* fp;
{
  INTlist start, prev, slot;
  int i;
  char c;

  start= prev= NULL;
  for (c= getc (fp); c != ')'; c= getc (fp)) {
    while (c == ',' || c == '\n' || c == ' ')
      c= getc (fp);
    (void) ungetc (c, fp);
    if (c != ')') {
      (void) fscanf (fp, "%d", &i);
      slot= newil ();
      slot->elt= i;
      slot->next= NULL;
      if (prev != NULL) {
	prev->next= slot;
	slot->cnt++;
      }
      else
	start= slot;
      prev= slot;
    }
  }
  (void) ungetc (c, fp);
  return start;
}


PRIVATE TNODE*
getnode (type, node)
	int	type;
	TNODE*	node;
{
  TNODE* aux;

  for (aux= gt_fs(node); aux != NULL; aux = gt_rb (aux))
    if (aux->type == type)
      return aux;

  return NULL;
}

/* makes the implementation of a exp */
PRIVATE void
impexp (nexp, llib)
	TNexp*	nexp;
	TNODE*	llib;
{
  TNODE* type;
  TNODE* pspe;
  Texpr* exp;

  exp = nexp->exp;
  for (type = gt_fs(llib); type != NULL; type = gt_rb (type))
    if ((int) find_attr (c_iddec, gt_fs(type))->value == (int) exp->type)
      break;
  assert (type != NULL);

  pspe = lksucc (type, tp_specification, PREORDER);

  exp -> make = TRUE;
  exp -> type = type;
  if (exp -> sorts != 0){
    exp -> sorts = getnode (tsorts, pspe);
    assert (exp->sorts != NULL);
  }
  if (exp -> opns != 0){
    exp -> opns = getnode (toperations, pspe);
    assert (exp->opns != NULL);
  }
  if (exp -> eqns != 0){
    exp -> eqns = getnode (tequations, pspe);
    assert (exp->eqns != NULL);
  }
  if (exp -> fsorts != 0){
    exp -> fsorts = getnode (tformal_sorts, pspe);
    assert (exp->fsorts != NULL);
  }
  if (exp -> fopns != 0){
    exp -> fopns = getnode (tformal_operations, pspe);
    assert (exp->fopns != NULL);
  }
  if (exp -> feqns != 0){
    exp -> feqns = getnode (tformal_equations, pspe);
    assert (exp->feqns != NULL);
  }
  if (nexp ->next != NULL){
    if (nexp->next->exp->make == FALSE){
      impexp (nexp->next, llib);
    }
  }
}

/* gets the sort of the argument of the operation */
PRIVATE INTlist
getnf (ffath, scp, nars, lexid)
	int     ffath;
	TNscp*	scp;
	int     nars;
	int     lexid;
{
  INTlist  decs;
  INTlist  argsl;
  INTlist  result= NULL;
  TNentry* entry;
  int      i;

  if ( ffath <= 0)
    return INTcons (0,(INTlist)NULL);

  if (scp == NULL)
    return INTcons (0,(INTlist)NULL);

  for (entry = scp -> next; entry != NULL; entry = entry -> next){
    if ((entry -> class == TOPN) ||
	(entry -> class == TFOPN) ||
	(entry -> class == TVAL)){
      for (decs = entry -> decs; decs != NULL; decs = INTtail (decs)){
	if (INThead (decs) == ffath){
	  argsl=(INTlist)ATfind (ATable,INThead(decs),c_argl)->value;
	  for (i =1; i<nars; argsl = INTtail (argsl), i++);
	  result = INTcons (INThead (argsl), result);
	}
      }
    }
  }

  return INTappend (result, getnf (ffath, scp->father, nars, lexid));
}

PRIVATE INTlist
getvargs (father)
	TNODE*  father;
{
  TNODE*   aux;
  INTlist args;

  args = NULL;
  for (aux = gt_fs (father); aux!=NULL; aux = gt_rb (aux))
    args = INTcons ((int) fdclr (c_varsort ,aux,1000+__LINE__ ), args);

  return INTrev(args);
}


PRIVATE INTlist*
getargs (father,nar)
	TNODE*  father;
	int     nar;
{
  int     i;
  TNODE*  aux;
  INTlist* args;

  args = (INTlist*) malloc ((unsigned) nar * sizeof (INTlist));
  if (args == NULL) {
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }

  for (i = 0, aux = gt_fs (father);
       i < nar ;
       i++, aux = gt_rb (aux))
    args [i]= (INTlist) fdclr (c_rposs,aux,1000+__LINE__ );

  return args;
}

PUBLIC int
isinlist (element, list)
     int     element;
     INTlist list;
{
  for (;list != NULL; list= INTtail (list))
      if (element == INThead (list))
	return TRUE;

  return FALSE;
} /* end of isinlist */

PRIVATE void
pil (list)
	INTlist list;
{

  (void) fprintf (stderr,"color:!");
  while (list != NULL){
    (void) fprintf(stderr, "%d!", INThead(list));
    list = INTtail(list);
  }
  (void) fprintf (stderr,"\n");
}


/**** applies the gs function to an element ***/
PRIVATE int
gselem (gs, element)
	INTlist gs;
	int     element;
{
  for (; gs != NULL; gs = INTtail (INTtail (gs)))
    if (element == INThead (gs))
      return INThead (INTtail (gs));

  return UNDEC;
}

/**** applies the gs function to an list ***/
PRIVATE INTlist
gslist (gs, list)
	INTlist gs;
	INTlist list;
{
  INTlist result=NULL;

  for (; list != NULL; list = INTtail (list))
     result = INTcons (gselem (gs, INThead (list)), result);

  return INTrev (result);
}

/** look for the name of an identifier in a renaming/actualization table */
PRIVATE int
isnameinlist (table, name)
	INTlist table;
	int     name;
{
  for (; table!= NULL; table = INTtail (INTtail(table)))
    if (INThead (table) == name)
      return INThead (INTtail(table));

  return 0;
}

/* return the new identifier  using the g[s,op] function */
PRIVATE int
findnew (org, g)
	int     org;
	INTlist g;
{
  for (; g != NULL; g = INTtail (INTtail (g)))
    if (INThead (g) == org)
      return INThead (INTtail (g));

  return 0;
}
/* cheks the loop dependencies between types */
PRIVATE int
depof (type, typelist)
	int     type;
	INTlist typelist;
{
  for (; typelist != NULL; typelist = INTtail (typelist)){
    if (type == INThead (typelist))
      return INThead (typelist);
    if (0!=depof(type,(INTlist)ATfind(ATable,INThead(typelist),c_deps)->value))
      return INThead (typelist);
  }
  return 0;
}
/* chech the non-overlapping data-presentation for sorts */
PRIVATE int
sortover (sort, sname, auxe)
	int    sort;
	int    sname;
	TNentry* auxe;
{
  INTlist auxl;
  int     auxs;

  for (; auxe != NULL; auxe = auxe -> next){
    if (auxe -> class == TSORT){
      for (auxl = auxe->decs; auxl != NULL; auxl = INTtail (auxl)){
	auxs = INThead (auxl);
	if ( (auxs > 0 ) && (auxs  != sort) &&
	    ((int)ATable->data[INThead (auxl)].value1 == sname))
	   return TRUE;
      }
    }
  }

  return FALSE;
}
/* chech the non-overlapping data-presentation for operations */
PRIVATE int
opnsover (opn, oname, argl, res, pos, auxe)
	int      opn;
	int      oname;
	INTlist  argl;
	int      res;
	int      pos;
	TNentry* auxe;
{
  INTlist auxl;
  int     lopn;
  int     lpos;

  for (; auxe != NULL; auxe = auxe -> next){
    if (auxe -> class == TOPN){
      for (auxl = auxe->decs; auxl != NULL; auxl = INTtail (auxl)){
	if ((lopn = INThead (auxl)) > 0){
	  if ((lopn != opn) && ((int)ATable->data[lopn].value1 == oname)){
	    if (res == (int) ATfind (ATable, lopn, c_sort)->value){
	      if (ATfind (ATable, lopn, c_infix) != NULL)
		lpos = infix;
	      else
		lpos = prefix;

	      if (lpos == pos){
		if (INTcmp(argl,(INTlist)ATfind (ATable, lopn, c_argl)->value)){
		  return TRUE;
		}
	      }
	    } /* res == (int) ATfind (ATable, lopn, c_sort)->value */
	  } /* if ((lopn != opn) && ((int)ATable->data[lopn].value1 == oname))*/
	}/* if ((lopn = INThead (auxl)) > 0) */
      } /* for (auxl = auxe->decs; auxl != NULL; auxl = INTtail (auxl))*/
    } /* if (auxe -> class == TOPN) */
  } /* for (; auxe != NULL; auxe = auxe -> next) */

  return FALSE;
}

/* checks the UNION of exp */
PRIVATE int
included (nexplist, nexp)
	TNexp* nexplist;
	TNexp* nexp;
{
  TNexp* auxnexp;

  for (auxnexp= nexplist; auxnexp != NULL; auxnexp= auxnexp->next){
    if ((auxnexp ->exp-> type == nexp->exp->type) &&
	((nexp->exp->sorts==NULL)||(nexp->exp->sorts==auxnexp->exp->sorts))&&
	((nexp->exp->opns==NULL) ||(nexp->exp->opns ==auxnexp->exp->opns))&&
	((nexp->exp->eqns==NULL) ||(nexp->exp->eqns ==auxnexp->exp->eqns))){
      if (INTcmp(nexp->exp->gs,auxnexp->exp->gs)&&
	  INTcmp(nexp->exp->go,auxnexp->exp->go))
	return TRUE;
    }
  }

  return FALSE;
}

/* apply the g functions to a type */
PRIVATE int
gtotype (exp)
	Texpr* exp;
{
  TNODE* sorts;
  TNODE* opns;
  TNODE* eqns;
  gvf = NULL;
  gof = exp->go;
  gsf = exp->gs;

  if (exp->sorts!= NULL){
    sorts = cp_tree (exp->sorts,TRUE);
    if (sorts == NULL){
      (void)fprintf(stderr,"lsa: not enough memory\n");
      exit(1);
    }
    visit (sorts);
    exp->sorts = sorts;
  }

  if (exp->opns!= NULL){
    opns = cp_tree (exp->opns,TRUE);
    if (opns == NULL){
      (void)fprintf(stderr,"lsa: not enough memory\n");
      exit(1);
    }
    visit (opns);
    exp->opns = opns;
  }
  if (exp->eqns!= NULL){
    eqns = cp_tree (exp->eqns,TRUE);
    if (eqns == NULL){
      (void)fprintf(stderr,"lsa: not enough memory\n");
      exit(1);
    }
    visit (eqns);
    exp->eqns = eqns;
  }

}

 /* makes the inclusion of new sorts / formal sorts */
PRIVATE void
addsorts (pspec, sorts, type)
	TNODE*	pspec;
	TNODE*	sorts;
	int	type;
{
  TNODE* aux=NULL;
  TNODE* old=NULL;
  TNODE* auxold=NULL;
  TNODE* new=NULL;
  TNODE* nlist=NULL;
  TNODE* act=NULL;

  sorts = cp_tree(sorts,TRUE);
  cut_tree (sorts);
  for (aux = gt_fs(pspec);
       (aux != NULL) && (aux->type != type);
       aux = aux->brothers)
    ;

  old = gt_fs(aux); /* first pointer to the old sort list */
  if (aux != NULL){
    for (new = gt_fs (sorts); new != NULL; ){
      for (auxold=gt_fs(aux); auxold != NULL; auxold=auxold->brothers)
	if ((int)find_attr(c_iddec,gt_fs(auxold))->value
	    ==
	    (int)find_attr(c_iddec,gt_fs(new))->value)
	  break;

      if (auxold == NULL){
	act = new;
	new = new->brothers;
	act->brothers=nlist;
	act->father=old->father;
	nlist = act;
      } else
	new= new->brothers;
    }
    for (auxold=old; auxold->brothers != NULL; auxold=auxold->brothers);
    auxold->brothers = nlist;

  } else{
    for (aux = gt_fs(pspec);
	 aux != NULL && (!ispos (aux, type));
	 aux = gt_rb (aux));

    /* sorts has to go before aux */
    if (aux == NULL) /* it must be the last one */
     aux = gt_ls (pspec);
    else /* aux := the previous one */
     aux = gt_lb (aux);

    /* sorts has to go after aux */
    if (aux == NULL){
      /* link as first son */
      sorts->brothers = pspec->sons;
      sorts->father   = pspec;
      pspec->sons     = sorts;
    } else { /* link after aux */
      sorts->brothers = aux->brothers;
      aux->brothers = sorts;
      sorts->father = pspec;
    }
  }
}

PRIVATE int
isinoplist(opnlist, opndesc)
	TNODE* opnlist;
	TNODE* opndesc;
{
  TNODE* aux;
  TNODE* aux1;

  for (aux= opnlist; aux != NULL; aux= gt_rb(aux)){
    /* aux is a toperation node */
    for (aux1= gt_fs(gt_fs(aux)); aux1!= NULL; aux1=gt_rb(aux1)){
      if ((int)find_attr(c_iddec,gt_fs(aux1))->value
	  ==
	  (int)find_attr(c_iddec,gt_fs(opndesc))->value)
	 return TRUE;

    }
  }

  return FALSE;
}
 /* makes the inclusion of new operations */
PRIVATE void
addopns (pspec, opns, type)
	TNODE*  pspec;
	TNODE*  opns;
	int	type;
{
  TNODE* aux=NULL;
  TNODE* old=NULL;
  TNODE* act;
  TNODE* auxnew;
  TNODE* new=NULL;
  TNODE* nlist=NULL;
  TNODE* prev=NULL;

  for (aux = gt_fs(pspec);
       (aux!= NULL) && (aux->type!=type);
       aux=gt_rb(aux));

  opns= cp_tree (opns,TRUE);
  if (opns == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }

  if (aux != NULL){
    old = gt_fs(aux); /* it is a toperation/formal toperation node */
    for (new = gt_fs (opns); new != NULL; ){
    /* new is a toperation node */
      auxnew=gt_fs(gt_fs(new));
      prev=NULL;
      while (auxnew != NULL){
      /* auxnew is an toperation_descriptor_list node */
	if (isinoplist(old, auxnew)){
	  prev = auxnew;
	  auxnew= gt_rb(prev);
	  cut_tree (prev);
	} else
	  auxnew = gt_rb(auxnew);
      }
      if (gt_fs(gt_fs(new)) != NULL){
	act = new;
	new = new->brothers;
	act->brothers=nlist;
	act->father=old->father;
	nlist = act;
      } else
	new= new->brothers;
    }
    for (aux=old; aux->brothers != NULL; aux=aux->brothers);
    aux->brothers = nlist;

  } else{
    for (aux = gt_fs(pspec);
	 aux != NULL && (!ispos (aux, type));
	 aux = gt_rb (aux));

    if (aux == NULL) /* it must be the last one */
     aux = gt_ls (pspec);
    else /* aux := the previous one */
     aux = gt_lb (aux);

    if (aux == NULL){
      opns ->brothers = pspec->sons;
      opns ->father   = pspec;
      pspec->sons     = opns;
    } else  { /* link after aux */
      opns->brothers  = aux->brothers;
      aux->brothers   = opns;
      opns->father    = pspec;
    }

  }
}

PRIVATE void
insertdecs (eqnslist, idecs)
	TNODE* eqnslist;
	TNODE* idecs;
{
  TNODE* aux1;
  TNODE* aux2;
  TNODE* aux;

  if (eqnslist->sons->type == tidentifier_declarations){
    for (aux1= idecs->sons; aux1!= NULL;){
      for (aux2 = eqnslist->sons->sons; aux2!= NULL; aux2 = gt_rb(aux2))
	if (cmptree (aux1, aux2)) break;
      if (aux2 == NULL){
	aux = aux1;
	aux1= gt_rb(aux1);
	cut_tree(aux);
	(void)lnsons  (eqnslist ->sons, aux);
      } else
	aux1= gt_rb(aux1);
    }
  }else{
    eqnslist->value1 = (CLR_TYPE)3;
    (void)lnnson  (eqnslist, idecs, 1);
  }
}

/*
********************************************************************************
* Calcula la clase de un nodo del tipo tp_specification
********************************************************************************
*/

PRIVATE int
clase (specification)
      TNODE* specification;

{
 TNODE* nodo;
  int n;

  if ((nodo = gt_fs (specification)) == NULL)
     return 0;
  n = 0;
  while (nodo != NULL) {
    switch (nodo -> type) {
      case tformal_sorts :
	n = n + 1;
	break;
      case tformal_operations :
	n = n + 2;
	break;
      case tformal_equations :
	n = n + 4;
	break;
      case tsorts :
	n = n + 8;
	break;
      case toperations :
	n = n + 16;
	break;
      case tequations :
	n = n + 32;
	break;
    }
    nodo = gt_rb (nodo);
  }
  return n;
}



PRIVATE void
del (id)
  int id;
{
  INTlist argl;

  assert (id <= ATable->size);
  switch ((int)ATable->data[id].value0){
    case TFSORT:
	 (void) printf ("formal sort: ");
    case TSORT:
	 (void) printf ("sort: ");
	 (void) printf (" nombre: %s\n",SymbolTable->data[(int)ATable->data[id].value1]);
	 break;
    case TFOPN:
	 (void) printf ("formal operation: ");
    case TOPN:
	 (void) printf ("operation: ");
	 (void) printf ("%s: ",SymbolTable->data[(int)ATable->data[id].value1]);
	 argl = (INTlist)ATfind (ATable, id, c_argl)->value;
	 for (; argl!=NULL; argl = INTtail (argl))
	   (void) printf ("%s ",SymbolTable->data[(int)ATable->data[INThead(argl)].value1]);
	 (void) printf ("-> %s\n",
	  SymbolTable->data[(int)ATable->data[(int)ATfind(ATable,id,c_sort)->value].value1]);
	 break;
    case TTYPE:
	 (void) printf ("type: %s\n",SymbolTable->data[(int)ATable->data[id].value1]);
	 break;
    case TVAL:
	 (void) printf ("variable: %s\n",SymbolTable->data[(int)ATable->data[id].value1]);
	 break;
    case TPROC:
	 (void) printf ("proceso: %s\n",SymbolTable->data[(int)ATable->data[id].value1]);
	 break;
    default:
	 (void) printf ("ninguno\n");
  }
}
PUBLIC int
comp_node ( n1 , n2 )
	  TNODE* n1;
	  TNODE* n2 ;
{
  TATTR* atd1;
  TATTR* atr1;
  TATTR* atd2;
  TATTR* atr2;

  if (((n1 == NULL) && (n2 != NULL)) ||
      ((n2 == NULL) && (n1 != NULL))) return FALSE;

 if ((n1->type == n2->type) && (n1->value1 == n2->value1)){
   atd1 = find_attr (c_iddec, n1);
   atr1 = find_attr (c_idref, n1);
   atd2 = find_attr (c_iddec, n2);
   atr2 = find_attr (c_idref, n2);

   if (atd1 == NULL) {
     if (atd2 != NULL)
       return FALSE;
   } else {
     if (atd2 == NULL)
       return FALSE;
     else
       if (atd1->value != atd2->value)
	 return FALSE;
   }
   if (atr1 == NULL) {
     if (atr2 != NULL)
       return FALSE;
   } else {
     if (atr2 == NULL)
       return FALSE;
     else
       if (atr1->value != atr2->value)
	 return FALSE;
   }
   return TRUE;
 }
 return FALSE;

}

PRIVATE int
cmptree (t1, t2)
	TNODE*	t1;
	TNODE*	t2;
{
  if ((t1 == NULL) && (t2 == NULL)) return TRUE;
  if (!comp_node ( t1, t2)) return FALSE ;

  for (t1=gt_fs(t1), t2=gt_fs(t2);
       (t1!= NULL ) && (t2 != NULL) ;
       t1 = gt_rb (t1), t2= gt_rb (t2))
    if (! cmptree (t1, t2)) return FALSE ;

  if ((t1 == NULL) && (t2 == NULL)) return TRUE;

  return FALSE;
}

PRIVATE void
inserteql (eqlist, neqlist)
	TNODE* eqlist;
	TNODE* neqlist;
{
  TNODE* next;
  TNODE* aux1;
  TNODE* aux2;
  TNODE* nlist=NULL;

  for (aux1 = gt_fs(neqlist); aux1!= NULL;){
    for (aux2 = gt_fs(eqlist); aux2!= NULL; aux2= gt_rb(aux2))
     if (cmptree (aux1, aux2))
       break;
    next= gt_rb(aux1);
    if (aux2 == NULL){
      cut_tree (aux1);
      aux1->brothers = nlist;
      nlist = aux1;
    }
    aux1 = next;
  }
  if (nlist != NULL){
    (void)lnsons (eqlist, nlist);
  }
}

 /* makes the inclusion of new equations */
PRIVATE void
addeqns (pspec, eqns, type)
	TNODE*  pspec;
	TNODE*  eqns;
	int	type;
{
  TNODE* aux;
  TNODE* tid;

  eqns=cp_tree (eqns,TRUE);
  cut_tree (eqns);
  for (aux = gt_fs(pspec);
       (aux!= NULL) && (aux->type!=type);
       aux=gt_rb(aux));

  if (aux != NULL){
    if (gt_fs(eqns)->type == tidentifier_declarations){
      tid = gt_fs(eqns);
      cut_tree(tid);
      insertdecs (aux, tid);
    }
    eqns = gt_fs(eqns);

    if (aux->sons->type == tidentifier_declarations)
      inserteql  (gt_rb(gt_fs(aux)), eqns);
    else
      inserteql  (gt_fs(aux), eqns);

  } else {
    for (aux = gt_fs(pspec);
	 aux != NULL && (!ispos (aux, type));
	 aux = gt_rb (aux));

    if (aux == NULL) /* it must be the last one */
     aux = gt_ls (pspec);
    else /* aux := the previous one */
     aux = gt_lb (aux);

    if (aux == NULL){
      eqns->brothers = pspec->sons;
      pspec->sons    = eqns;
      eqns->father   = pspec;
    } else {
      eqns->brothers = aux->brothers;
      aux->brothers = eqns;
      eqns->father  = pspec;
    }
  }
}

/* makes the union of the expression to built the sflt TYPE */
PRIVATE void
unir (type, exp, canon)
	TNODE*	type;
	Texpr*  exp;
	int	canon;
{
  TNODE* pspec;
  pspec = lksucc (type, tp_specification, PREORDER);

  if (exp->sorts != NULL)
    addsorts (pspec,exp->sorts, tsorts);
  if (exp->opns  != NULL)
    addopns (pspec,exp->opns, toperations);
  if (exp->eqns  != NULL)
    addeqns (pspec,exp->eqns, tequations);

  if (canon == FALSE){
    if (exp->fsorts != NULL)
      addsorts (pspec,exp->fsorts, tformal_sorts);
    if (exp->fopns  != NULL)
      addopns (pspec,exp->fopns, tformal_operations);
    if (exp->feqns  != NULL)
      addeqns (pspec,exp->feqns, tformal_equations);
  }
}

PRIVATE void
newclase (adt)
	 TNODE* adt; /*ttype_definition */
{
  TNODE* nodo;
  TNODE* pexp;

  if (adt != NULL) {
    pexp = gt_rb (gt_fs (adt)); /* tp_expression */
    pexp -> value0 = (CLR_TYPE)IATadd (grnp_expression, grnl, TRUE);
    nodo = gt_fs (pexp); /* ttype_union or tp_specification */
    if (nodo -> type == ttype_union){
      pexp -> value1 = (CLR_TYPE)3;
      nodo = gt_rb(nodo);
    } else
      pexp -> value1 =(CLR_TYPE)2;
    /*  tp_specification */
    nodo -> value1 = (CLR_TYPE)clase (nodo);
  }
}


/*****  public functions *****/

/*** apply the g function to an unique identifier ***/
PUBLIC int
applyg (g, value)
	INTlist	g;
	int	value;
{
  for (; g != NULL; g = INTtail (INTtail (g)))
    if (INThead (g) == value)
      return INThead (INTtail (g));

  return UNDEC;
}


/* read one exp list   */
PUBLIC CLR_TYPE
readexp (fp)
	FILE*  fp;
{
  TNexp* nexp;
  Texpr* expr;
  char*  st;
  char   c;
  int    i;

  st = malloc (100);
  if (st == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }

  nexp = newnexp ();
  expr = newexpr ();
  nexp->exp=expr;

  /*c= getc (fp);
  c= getc (fp);*/
  (void) fscanf (fp, "%s", st);
  if (strcmp (st, "TYPE") != 0){
    (void) fprintf (stderr, "Error while scanning input file exp\n");
    exit (1);
  }
  (void) fscanf (fp," %d", &i);
  expr->type = (TNODE*)i;

  (void) fscanf (fp," %d", &i);
  expr->complete = i;

  (void) fscanf (fp," %d", &i);
  expr->sorts = (TNODE*)i;

  (void) fscanf (fp," %d", &i);
  expr->opns = (TNODE*)i;

  (void) fscanf (fp," %d", &i);
  expr->eqns = (TNODE*)i;

  (void) fscanf (fp," %d", &i);
  expr->fsorts = (TNODE*)i;

  (void) fscanf (fp," %d", &i);
  expr->fopns = (TNODE*)i;

  (void) fscanf (fp," %d", &i);
  expr->feqns = (TNODE*)i;

  c=getc(fp);
  c=getc(fp);

  c=getc(fp);
  if (c != '}'){
    (void) ungetc (c, fp);
    expr->gs = mgetINTlist (fp);
  } else
    (void) ungetc (c, fp);

  c=getc(fp);
  c=getc(fp);
  c=getc(fp);

  c=getc(fp);
  if (c != '}'){
    (void) ungetc (c, fp);
    expr->go = mgetINTlist (fp);
  } else
    (void) ungetc (c, fp);

  c=getc(fp);
  c=getc(fp);
  c=getc(fp);

  c=getc(fp);
  if (c == 'T'){
    (void) ungetc (c, fp);
    nexp->next = (TNexp*) readexp (fp);
  } else
    (void) ungetc (c, fp);

  return (CLR_TYPE) nexp;


}
/* print one exp list */
PUBLIC void
putexp (fp, nexp)
	FILE*  fp;
	TNexp* nexp;
{
  int     typeid;
  Texpr*  exp;

  for (; nexp  != NULL; nexp = nexp -> next){
    exp = nexp->exp;
    if (exp->make == TRUE)
      typeid = (int)find_attr (c_iddec, gt_fs (exp->type))->value;
    else
      typeid = (int)exp->type;

    (void) fprintf (fp, "TYPE %d %d ", typeid, exp->complete);

    if (exp->sorts == NULL)
      (void) fprintf (fp, "0 ");
    else
      (void) fprintf (fp, "-1 ");

    if (exp->opns == NULL)
      (void) fprintf (fp, "0 ");
    else
      (void) fprintf (fp, "-1 ");

    if (exp->eqns == NULL)
      (void) fprintf (fp, "0 " );
    else
      (void) fprintf (fp, "-1 ");

    if (exp->fsorts == NULL)
      (void) fprintf (fp, "0 ");
    else
      (void) fprintf (fp, "-1 ");

    if (exp->fopns == NULL)
      (void) fprintf (fp, "0 ");
    else
      (void) fprintf (fp, "-1 ");
    if (exp->feqns == NULL)
      (void) fprintf (fp, "0 ");
    else
      (void) fprintf (fp, "-1 ");

    (void) fprintf (fp, "(");
    if (exp->gs != NULL)
      putINTlist (fp, (CLR_TYPE)exp->gs);
    (void) fprintf (fp, ") ");

    (void) fprintf (fp, "(");
    if (exp->go != NULL)
      putINTlist (fp, (CLR_TYPE)exp->go);
    (void) fprintf (fp, ") ");
    /*
    if (exp->gs != NULL){
	(void) fprintf (fp, "sort:");
	for (L= (INTlist) exp->gs; L->next != NULL; L= L->next)
	  (void) fprintf (fp, "%d,", L->elt);
	(void) fprintf (fp, "%d;", L->elt);
    }
    if (exp->go != NULL){
	(void) fprintf (fp, "opns:");
	for (L= (INTlist) exp->go; L->next != NULL; L= L->next)
	  (void) fprintf (fp, "%d,", L->elt);
	(void) fprintf (fp, "%d;", L->elt);
    }
    */
    (void) fprintf (fp, "|");
  }
}

/* print one scp entry */
PUBLIC void
putscp (fp, scp)
	FILE*  fp;
	TNscp* scp;
{
  INTlist       L;
  TNentry*      aux;

  if (scp != NULL){
    for (aux = scp -> next;
	 aux!= NULL;
	 aux = aux->next){
      switch (aux->class){
	case TSPEC:
	       (void) fprintf (fp, "SPEC|");
	       break;
	case TTYPE:
	       (void) fprintf (fp, "TYPE|");
	       break;
	case TFSORT :
	       (void) fprintf (fp, "FSORT|");
	       break;
	case TFOPN:
	       (void) fprintf (fp, "FOPN|");
	       break;
	case TSORT :
	       (void) fprintf (fp, "SORT|");
	       break;
	case TOPN:
	       (void) fprintf (fp, "OPN|");
	       break;
	case TPROC:
	       (void) fprintf (fp, "PROC|");
	       break;
	case TGATE:
	       (void) fprintf (fp, "GATE|");
	       break;
	case TVAL:
	       (void) fprintf (fp, "VAL|");
	       break;
      }
      if (aux->decs != NULL){
	for (L= (INTlist) aux->decs; L->next != NULL; L= L->next)
	  (void) fprintf (fp, "%d,", L->elt);
	(void) fprintf (fp, "%d", L->elt);
      }

      (void) fprintf (fp, "|");
    }
  }
}

PUBLIC INTlist
INTunion	(first, second)
	INTlist	first;
	INTlist	second;
{
  INTlist   aux;
  INTlist   idlist=NULL;

  idlist = first;
  for (aux = second; aux != NULL; aux = INTtail(aux)){
      if (!isinlist (INThead (aux), idlist))
	idlist = INTcons (INThead (aux), idlist);
  }
  return idlist;
}
PUBLIC INTlist
addintlist	(class, first)
	int	class;
	TNODE*	first;
{
  TNODE*    aux;
  INTlist   auxlist;
  INTlist   idlist=NULL;

  for (aux = first; aux != NULL; aux = gt_rb(aux)){
    for (auxlist = (INTlist)fdclr(class,aux,1000+__LINE__);
	 auxlist != NULL;
	 auxlist = INTtail (auxlist)){
      if (!isinlist (INThead (auxlist), idlist))
	idlist = INTcons (INThead (auxlist), idlist);
    }
  }
  return idlist;
}

PUBLIC INTlist
addint	(class, first)
	int	class;
	TNODE*	first;
{
  TNODE*    aux;
  int	    elem;
  INTlist   idlist=NULL;

  for (aux = first; aux != NULL; aux = aux->brothers){
    elem = (int)fdclr(class,aux,1000+__LINE__);
    if (!isinlist (elem, idlist))
      idlist = INTcons (elem, idlist);
  }

  return idlist;
}
PUBLIC INTlist
cintlist	(class, first)
	int	class;
	TNODE*	first;
{
  TNODE*    aux;
  INTlist   idlist=NULL;

  for (aux = first; aux != NULL; aux = gt_rb(aux))
    idlist = INTappend (idlist, (INTlist)fdclr(class,aux,1000+__LINE__));

  return idlist;
}

PUBLIC INTlist
cint	(class, first)
	int	class;
	TNODE*	first;
{
  TNODE*    aux;
  INTlist   idlist=NULL;

  for (aux = first; aux != NULL; aux = aux->brothers)
   idlist = INTcons ((int)fdclr(class,aux,1000+__LINE__), idlist);

  return idlist;
}


/* makes a new scp node */
PUBLIC TNscp *
newscp ()

{
  TNscp*	new;

  new = (TNscp*) malloc ( sizeof (TNscp));
  if (new == NULL){
    (void) fprintf(stderr,"lsa:  not enough memory\n");
    exit(1);
  }
  new -> father = NULL ;
  new -> next   = NULL ;

  return new;
}

/* makes a new declaration entry node */
PUBLIC TNentry*
newentry ()

{
  TNentry*	new;

  new = (TNentry*) malloc ( sizeof (TNentry));
  if (new == NULL){
    (void) fprintf(stderr,"lsa:  not enough memory\n");
    exit(1);
  }
  new -> next   = NULL ;
  new -> class  = NONE ;
  new -> decs   = NULL ;
  return new;
}


/* links a scp entry with its parent scp entry */
PUBLIC TNscp*
linkscp (son, father)
	TNscp*	son;
	TNscp*	father;
{
  assert ( son != NULL);
  assert ( father != NULL);

  son->father = father;
  return son;
}

/* puts more list of declarations to an scp entry */
PUBLIC TNscp*
addentry	(scp, class, decs)
	TNscp*	scp;
	int	class;
	INTlist	decs;

{
  TNentry*	new;

  assert (scp != NULL);

  new = newentry ();
  new -> class  = class;
  new -> decs   = decs;
  new -> next   = scp -> next;
  scp -> next   = new;

  return scp;
}

/* puts more list of declarations to an scp entry */
PUBLIC TNscp*
addentries	(scp, class, news)
	TNscp*	scp;
	int	class;
	TNscp*	news;

{
  TNentry*	aux;

  assert (scp != NULL);
  assert (news != NULL);

  for (aux = news -> next; aux != NULL; aux = aux -> next)
    if (aux->class == class)
      (void) addentry (scp, class, aux ->decs);

  return scp;
}

/* copy entries from one node to one scp */
PUBLIC void
cpentries (to, class, node)
  TNscp*	to;
  /* KJT 20/01/23: added declaration of "class" */
  int class;
  TNODE*	node;
{
  INTlist	decs;

  assert (to != NULL);
  assert (node != NULL);

  switch (class){
    case TTYPE:
	 decs= (INTlist) fdclr (c_types, node, 1000+__LINE__) ;
	 (void) addentry (to, c_types, decs);
	 break;
    case TPROC:
	 decs= (INTlist) fdclr (c_procs, node, 1000+__LINE__) ;
	 (void) addentry (to, c_procs, decs);
	 break;
    case TGATE:
	 decs= (INTlist) fdclr (c_gates, node, 1000+__LINE__) ;
	 (void) addentry (to, c_gates, decs);
	 break;
    case TSORT:
	 decs= (INTlist) fdclr (c_sorts, node, 1000+__LINE__) ;
	 (void) addentry (to, c_sorts, decs);
	 break;
    case TOPN:
	 decs= (INTlist) fdclr (c_opns, node, 1000+__LINE__) ;
	 (void) addentry (to, c_opns, decs);
	 break;
    case TVAL:
	 decs= (INTlist) fdclr (c_vals, node, 1000+__LINE__) ;
	 (void) addentry (to, c_vals, decs);
	 break;
    case TFSORT:
	 decs= (INTlist) fdclr (c_fsorts, node, 1000+__LINE__) ;
	 (void) addentry (to, c_fsorts, decs);
	 break;
    case TFOPN:
	 decs= (INTlist) fdclr (c_fopns, node, 1000+__LINE__) ;
	 (void) addentry (to, c_fopns, decs);
	 break;
  }

  if ((find_attr (-c_locals, node) != NULL) ||
      (find_attr ( c_locals, node) != NULL)){
     (void) addentries (to, class, (TNscp*)fdclr(c_locals,node,1000+__LINE__));
  }
}

/* declaration of operations */
PUBLIC int
odec (lexv, argl, sort, position, class, line)
	int	lexv;
	INTlist	argl;
	int	sort;
	int	position;
	int	class;
	int*	line;
{
  int uid;

  if (class == nformal)
    class = TOPN;
  else
    class = TFOPN;

  uid = ATinc (ATable);
  ATable->data[uid].value0 =  (CLR_TYPE) class;
  ATable->data[uid].value1 =  (CLR_TYPE) lexv;

  /* insert in the ATable the unique identifier for class */
  if (class == TOPN)
    ATset (ATable, uid, c_ui, (CLR_TYPE)opns_unique++);
  else
    ATset (ATable, uid, c_ui, (CLR_TYPE)fopns_unique++);

  /* insert in the ATable the operation related information */
  ATset (ATable, uid, c_line, (CLR_TYPE)line);
  ATset (ATable, uid, c_argl, (CLR_TYPE)argl);
  ATset (ATable, uid, c_sort, (CLR_TYPE)sort);
  ATset (ATable, uid, c_nar, (CLR_TYPE)INTlength(argl));

  /* public list of argument sorts */
  ATset (ATable, uid, c_sargl, (CLR_TYPE)argl);

  if (position == infix)
    ATset (ATable, uid, c_infix, (CLR_TYPE)0);

  return uid;
}

/* declaration of values */
PUBLIC int
vdec (lexv, sort)
	int	lexv;
	int	sort;
{
  int uid;

  uid = ATinc (ATable);
  ATable->data[uid].value0 =  (CLR_TYPE) TVAL;
  ATable->data[uid].value1 =  (CLR_TYPE) lexv;

  /* insert in the ATable the unique identifier for class */
  ATset (ATable, uid, c_ui, (CLR_TYPE)vals_unique++);

  ATset (ATable, uid, c_sort, (CLR_TYPE)sort);
  ATset (ATable, uid, c_nar, (CLR_TYPE)0);

  return uid;
}
/* declaration of sorts */
PUBLIC int
sdec (lexv, class, line)
	int	lexv;
	int	class;
	int*	line;
{
  int uid;

  if (class == nformal)
    class = TSORT;
  else
    class = TFSORT;

  uid = ATinc (ATable);
  ATable->data[uid].value0 =  (CLR_TYPE) class;
  ATable->data[uid].value1 =  (CLR_TYPE) lexv;

  /* insert in the ATable the unique identifier for class */
  if ( class == TSORT)
    ATset (ATable, uid, c_ui, (CLR_TYPE)sort_unique++);
  else
    ATset (ATable, uid, c_ui, (CLR_TYPE)fsort_unique++);


  ATset (ATable, uid, c_line, (CLR_TYPE)line);

  return uid;
}

/* declaration of gates */
PUBLIC int
gdec (lexv)
	int	lexv;
{
  int uid;

  uid = ATinc (ATable);
  ATable->data[uid].value0 =  (CLR_TYPE) TGATE;
  ATable->data[uid].value1 =  (CLR_TYPE) lexv;

  /* insert in the ATable the unique identifier for class */
  ATset (ATable, uid, c_ui, (CLR_TYPE)gate_unique++);

  return uid;
}

/* declaration of types */
PUBLIC int
tdec (lexv, addr)
	int	lexv;
	TNODE*	addr;
{
  int uid;

  uid = ATinc (ATable);
  ATable->data[uid].value0 =  (CLR_TYPE) TTYPE;
  ATable->data[uid].value1 =  (CLR_TYPE) lexv;

  /* insert in the ATable the unique identifier for class */
  ATset (ATable, uid, c_ui, (CLR_TYPE)type_unique++);

  ATset (ATable, uid, c_deps, (CLR_TYPE)NULL);
  ATset (ATable, uid, c_addr, (CLR_TYPE)addr);

  return uid;
}

/* declaration of process */
PUBLIC int
pdec (lexv, gates, vals, func)
	int	lexv;
	INTlist	gates;
	INTlist	vals;
	INTlist	func;
{
  int uid;

  uid = ATinc (ATable);
  ATable->data[uid].value0 =  (CLR_TYPE) TPROC;
  ATable->data[uid].value1 =  (CLR_TYPE) lexv;

  /* insert in the ATable the unique identifier for class */
  ATset (ATable, uid, c_ui, (CLR_TYPE)proc_unique++);

  ATset (ATable, uid, c_gates, (CLR_TYPE)gates);
  ATset (ATable, uid, c_vals, (CLR_TYPE)vals);
  ATset (ATable, uid, c_func, (CLR_TYPE)func);

  return uid;
}

/* declaration of specifications */
PUBLIC int
spdec (lexv, gates, vals, func)
	int	lexv;
	INTlist	gates;
	INTlist	vals;
	INTlist	func;
{
  int uid;

  uid = ATinc (ATable);
  ATable->data[uid].value0 =  (CLR_TYPE) TSPEC;
  ATable->data[uid].value1 =  (CLR_TYPE) lexv;

  /* insert in the ATable the unique identifier for class */
  ATset (ATable, uid, c_ui, (CLR_TYPE)spec_unique++);

  ATset (ATable, uid, c_gates,(CLR_TYPE)gates);
  ATset (ATable, uid, c_vals, (CLR_TYPE)vals);
  ATset (ATable, uid, c_func, (CLR_TYPE)func);

  return uid;
}

/* find the reference of a sort */
PUBLIC int
sref (lexv, scp, isformal)
	int	lexv;
	TNscp*	scp;
	int	isformal;
{
  TNentry*	entry;
  INTlist	decs;
  int		result = 0;

  if (scp == NULL)
    return UNDEC;

  for (entry = scp -> next; entry !=  NULL; entry = entry -> next)
    if (((isformal == formal) && (entry -> class ==TFSORT)) ||
	((isformal == nformal) && ((entry -> class == TSORT) || (entry -> class == TFSORT)))){
      for (decs = entry -> decs; decs != NULL; decs = INTtail (decs))
	if ((int)ATable->data[INThead (decs)].value1 == lexv){
	  if ((result == 0) || (result == INThead (decs)))
	    result = INThead (decs);
	  else
	    return UNRES;
	}
    }

  if (result == 0)
    return sref (lexv, scp-> father, isformal);

  return result;
}

/* find the reference of a type */
PUBLIC int
tref (lexv, scp)
	int	lexv;
	TNscp*	scp;
{
  TNentry*	entry;
  INTlist	decs;
  int		result = 0;

  if (scp == NULL)
    return UNDEC;

  for (entry = scp -> next; entry != NULL; entry = entry -> next)
    if (entry -> class == TTYPE){
      for (decs = entry -> decs; decs != NULL; decs = INTtail (decs))
	if ((int)ATable->data[INThead (decs)].value1 == lexv){
	  if ((result == 0) || (result == INThead (decs)))
	    result = INThead (decs);
	  else
	    return UNRES;
	}
    }

  if (result == 0)
    return tref (lexv, scp-> father);

  return result;
}

/* find the reference of a process */
PUBLIC int
pref (lexv, scp)
	int	lexv;
	TNscp*	scp;
{
  TNentry*	entry;
  INTlist	decs;
  int		result = 0;

  if (scp == NULL)
    return UNDEC;

  for (entry = scp -> next; entry != NULL; entry = entry -> next)
    if (entry -> class == TPROC){
      for (decs = entry -> decs; decs != NULL; decs = INTtail (decs))
	if ((int)ATable->data[INThead (decs)].value1 == lexv){
	  if ((result == 0) || (result == INThead (decs)))
	    result = INThead (decs);
	  else
	    return UNRES;
	}
    }

  if (result == 0)
    return pref (lexv, scp-> father);

  return result;
}

/* find the reference of a gate */
PUBLIC int
gref (lexv, scp)
	int	lexv;
	TNscp*	scp;
{
  TNentry*	entry;
  INTlist	decs;
  int		result = 0 ;

  if (scp == NULL)
    return UNDEC;

  for (entry = scp -> next; entry != NULL; entry = entry -> next)
    if (entry -> class == TGATE){
      for (decs = entry -> decs; decs != NULL; decs = INTtail (decs))
	if ((int)ATable->data[INThead (decs)].value1 == lexv){
	  if ((result == 0) || (result == INThead (decs)))
	    result = INThead (decs);
	  else
	    return UNRES;
	}
    }

  if (result == 0)
    return gref (lexv, scp-> father);

  return result;
}

/* getinher -- evaluates the inher value for this operation */

PUBLIC int
getinher (node)
	TNODE*	node;
{
	TATTR*	attr1;
	TATTR*	attr2;
	int	sidref;

  if (find_attr (-c_inher, node) != NULL)
     (void) fdclr (c_inher, node, 1000+__LINE__ );
  attr1 = find_attr (c_inher, node);
  if (find_attr (-c_sidref, node) != NULL)
     (void) fdclr (c_sidref, node, 1000+__LINE__ );
  attr2 = find_attr (c_sidref, node);
  if ((int) attr2->value <= 0)
    sidref = 0;
  else sidref = (int) attr2->value ;

  if ( attr1 == NULL)
    if ( attr2 == NULL)
      return 0;
    else
      return sidref;
  else{

    if (( attr2 == NULL) || (sidref == 0))
      return (int) attr1 -> value;
    else
      if ((int)attr1->value == 0)
	return sidref;
      else if ((int)attr1->value == sidref)
	     return (int) attr1->value;
	   else
	     return 0;
  }
}

/* gets the idref for an operation/value reference,
   from the "poss" and the "father" attibutes */
PUBLIC int
getoid (node, lexv, scp, poss)
	TNODE*	node;
	int	lexv;
	TNscp*	scp;
	INTlist	poss;
{
  TNODE*   father;
  TNODE*   aux;
  INTlist  ffath;  /* from father mandatory sort of result */
  INTlist  decs;
  int      nar;
  int      sort;
  int	   isf;
  INTlist  result = NULL;
  INTlist  auxnode;
  INTlist  aux2;

  if (scp == NULL)
    return UNDEC;

  father = gt_ft(node);
  for (aux = gt_fs(father), nar = 1;
       aux != node;
       aux = gt_rb (aux))
    nar++;

  if (father -> type == tvalue_expression)
    ffath = getnf ((int)fdclr (c_idref, father, 1000 + __LINE__),
		   scp,
		   nar,
		   (int)fdclr (c_lexv, father, 1000 + __LINE__));
  else
    ffath = INTcons (0, (INTlist)NULL);

  decs = INTtail (poss);
  while (decs != NULL){
    result = NULL;
    for (; INThead (decs) != -1; decs = INTtail (decs)){
      sort = (int) ATfind (ATable, INThead(decs), c_sort)->value;
      if ((INThead (ffath) == 0) || (sort == INThead (ffath)))
	if ((result == NULL) || (INThead(result) != INThead(decs)))
	  result = INTcons(INThead(decs),result);
    }
    if (INTlength(result) == 1)
      break; /* when there is only one dec in this scope */

    if (INTlength(result) > 0){
      for (auxnode= result; auxnode != NULL; auxnode = INTtail (auxnode)){
	isf = 0;
	for (aux2 = result;
	     (aux2 != NULL)&&((isf == 1)|| (isf ==0));
	     aux2 = INTtail (aux2)){
	  if (INThead (aux2) != INThead (auxnode)){
	    switch (isfirst (INThead(auxnode), INThead (aux2), node)){
	      case 1 : isf = 1; break;
	      case 0 : break;
	      case -1:
	      case 2 : isf = 2; break;
	    }
	  }
	}
	if (isf == 1)
	  return INThead (auxnode);
      }
      return UNRES;
    }
    decs = INTtail (decs);
  }
  /* check minimal assignation for operations */
  if  (INTlength(result) == 1){
    while (decs != NULL){
      for (; INThead (decs) != -1; decs = INTtail (decs)){
	sort = (int) ATfind (ATable, INThead(decs), c_sort)->value;
	if ((INThead (ffath) == 0) || (sort == INThead (ffath)))
	  if (INThead(result) != INThead(decs))
	    switch (isfirst (INThead(result), INThead (decs), node)){
	      case 1 : break;
	      case 0 : break;
	      case -1: return UNRES;
	      case 2 : return UNRES;
	    }
      }
      decs = INTtail (decs);
    }
    return INThead(result);
  }
  return UNDEC;
}


/* getnar -- evaluates the number of arguments */
PUBLIC int
getnar (father)
	TNODE*	father;
{
	int	n=0;
	TNODE*	aux;
  for (aux = gt_fs (father); aux != NULL; aux = gt_rb(aux))
    n++;

  return n;
}

/* getpos -- evaluates if the operation is prefix or infix */
PUBLIC int
getpos ( node )
	TNODE*	node;
{
  if (find_attr(-c_infix, node) != NULL)
    return infix;
  if (find_attr(c_infix, node) != NULL)
    return infix;
  return prefix;
}


/* getrpos -- get the set of possible sorts as result */
PUBLIC INTlist
getrpos (poss)
	INTlist	poss;
{
  INTlist	result= NULL;
  int		value;

  for (; poss != NULL ; poss = INTtail (poss))
    if ((value = INThead (poss)) > 0)
      result = INTcons ((int)ATfind (ATable,value, c_sort)->value, result);

  return result;
} /* end of getrpos */


/* getposs -- get the list of possible operations */
PUBLIC INTlist
getposs (father, lexv, position, nar, inher, scp, isformal)
	TNODE*	father;
	int  	lexv;
	int	position;
	int	nar;
	int	inher;
	TNscp*	scp;
	int     isformal;
{
  TNentry* entry;
  INTlist* args;
  INTlist  result = NULL;
  INTlist  decs;
  INTlist  argl;
  int      uid;
  int      equals;
  int      i;

  if (scp == NULL)
    return INTcons (-1, (INTlist) NULL );;

  args = getargs (father, nar);

  for (entry = scp -> next; entry != NULL; entry = entry -> next)
    if (((isformal==formal) && (entry -> class == TFOPN))||
	((isformal==nformal)&&((entry->class==TOPN)||(entry->class==TFOPN)))||
	(entry->class==TVAL)
       ){
      for (decs = entry -> decs; decs != NULL; decs = INTtail (decs)){
	uid = INThead (decs);
	if ((uid>0) && ((int)ATable->data[uid].value1 == lexv)&&
	    (nar == (int) ATfind (ATable, uid, c_nar) ->value)){
	  if (((position == prefix) && ATfind (ATable, uid, c_infix) == NULL)||
	      ((position == infix) && ATfind (ATable, uid, c_infix)!= NULL)){
	    equals = TRUE;
	    if ((entry -> class == TOPN)||
		(entry -> class == TFOPN))
	      for (i=0,argl=(INTlist)ATfind(ATable,uid,c_argl)->value;
		   i < nar;
		   argl= INTtail (argl), i++){
	      if (!isinlist(INThead(argl), args[i])){
		equals = FALSE;
		break;
	      }
	    }
	    if (equals &&
		((inher==0)||((int)ATfind(ATable,uid,c_sort)->value==inher))&&
		(!isinlist(uid, result))){
	      if ((result == NULL) || (!isinlist (INThead (decs), result)))
		result = INTcons (INThead (decs), result);
	      else
		return INTcons (UNRES, result);
	    } /* end of the if */
	  } /* end of the if */
	} /* end of the if */
      } /* end of the for */
    } /* end of the if */

  if (result == NULL)
    result= getposs (father,lexv,position,nar,inher,scp->father,isformal);
  else
    result=
       INTappend(INTcons (-1, result),
		 getposs(father,lexv,position,nar,inher,scp->father,isformal));

  return result;
}


/***** functions to handle the exp elements ****/

/** makes a new expr node ***/
PUBLIC Texpr*
newexpr ()
{
  Texpr* new;

  new = (Texpr*) malloc ((unsigned) sizeof (Texpr));
  if (new == NULL){
    (void) fprintf(stderr,"lsa:  not enough memory\n");
    exit(1);
  }
  new -> make    = FALSE;
  new -> type    = NULL;
  new -> complete= TRUE;
  new -> sorts   = NULL;
  new -> opns    = NULL;
  new -> eqns    = NULL;
  new -> fsorts  = NULL;
  new -> fopns   = NULL;
  new -> feqns   = NULL;
  new -> gs      = NULL;
  new -> go      = NULL;

  return new;
}
/** makes a new nexp node ***/
PUBLIC TNexp*
newnexp ()
{
  TNexp* slot;
  TNexp* buck;
  int i;

  if (freenexp == NULL) {
    buck= (TNexp*) malloc (BUCKSIZE * sizeof (TNexp));
    if (buck == NULL){
      (void) fprintf (stderr,"lsa: not enough memory\n");
      exit (1);
    }
    for (i= 0; i < BUCKSIZE; i++)
      buck[i].next= &buck[i+1];
    freenexp= buck;
    buck[BUCKSIZE-1].next= NULL;
  }
  slot= freenexp;
  freenexp= freenexp->next;
  slot -> next    = NULL;
  slot -> exp     = NULL;

  return slot;
}

/** makes a new exp entry ***/
PUBLIC TNexp*
mkexp (pexp)
	TNODE* pexp;
{
  TNODE*  sons;
  TNexp*  result;
  Texpr*  exp;
  INTlist gs = NULL;
  INTlist go = NULL;
  INTlist aux;
  INTlist paux;
  INTlist fsorts=NULL;
  INTlist sorts=NULL;
  INTlist fopns=NULL;
  INTlist opns=NULL;
  INTlist rsorts=NULL;
  INTlist ropns=NULL;

  exp   = newexpr ();
  result= newnexp ();
  result->exp = exp;

  exp -> make = TRUE;
  exp -> type = gt_ft(gt_ft(pexp));
  exp -> complete = TRUE;

  for (sons = gt_fs (pexp);sons != NULL; sons = gt_rb(sons))
    switch (sons -> type){
      case tformal_sorts:
	   exp -> fsorts = sons;
	   fsorts = (INTlist)fdclr (c_fsorts, sons, 1000+__LINE__ );
	   for (aux = fsorts;
		aux != NULL; aux = INTtail (aux))
	     gs = INTcons (INThead (aux), INTcons (INThead (aux),gs));
	   break;
      case tformal_operations:
	   exp -> fopns = sons;
	   fopns = (INTlist)fdclr (c_fopns, sons, 1000+__LINE__ );
	   for (aux = fopns;
		aux != NULL; aux = INTtail (aux))
	     go = INTcons (INThead (aux), INTcons (INThead (aux),go));
	   rsorts = (INTlist)fdclr (c_rsorts, sons, 1000+__LINE__ );
	   break;
      case tformal_equations:
	   exp -> feqns = sons;
	   rsorts = INTappend(rsorts,
			      (INTlist)fdclr (c_rsorts, sons, 1000+__LINE__ ));
	   ropns  = (INTlist)fdclr (c_ropns , sons, 1000+__LINE__ );
	   break;
      case tsorts:
	   exp -> sorts = sons;
	   sorts = (INTlist) fdclr (c_sorts, sons, 1000+__LINE__ );
	   for (aux = sorts;
		aux != NULL; aux = INTtail (aux))
	     gs = INTcons (INThead (aux), INTcons (INThead (aux),gs));
	   break;
      case toperations:
	   exp -> opns = sons;
	   opns = (INTlist)fdclr (c_opns, sons, 1000+__LINE__ );
	   for (aux = opns;
		aux != NULL; aux = INTtail (aux))
	     go = INTcons (INThead (aux), INTcons (INThead (aux),go));
	   rsorts = INTappend(rsorts,
			      (INTlist)fdclr(c_rsorts,sons,1000+__LINE__ ));
	   break;
      case tequations:
	   exp -> eqns = sons;
	   rsorts = INTappend(rsorts,
			      (INTlist)fdclr(c_rsorts,sons,1000+__LINE__ ));
	   ropns  = INTappend(ropns,
			      (INTlist)fdclr (c_ropns , sons, 1000+__LINE__ ));
	   break;
    }

  for (aux = rsorts, paux = NULL; aux != NULL; aux = INTtail (aux)){
    if ((!isinlist (INThead (aux), paux))&&
	(!isinlist (INThead (aux), sorts))&&
	(!isinlist (INThead (aux), fsorts)))
	 gs = INTcons (INThead (aux), INTcons (INThead (aux),gs));
    paux = INTcons (INThead(aux),paux);
  }
  for (aux = ropns,paux=NULL; aux != NULL; aux = INTtail (aux)){
    if ((!isinlist (INThead (aux), paux))&&
	(!isinlist (INThead (aux), opns))&&
	(!isinlist (INThead (aux), fopns)))
	 go = INTcons (INThead (aux), INTcons (INThead (aux),go));
    paux = INTcons (INThead(aux),paux);
  }

  exp -> gs = gs;
  exp -> go = go;
  return result;
}

/*** return a copy of the exp ***/
PUBLIC TNexp*
cpnexp  (old)
	TNexp*	old;
{
  TNexp* new   = NULL;
  TNexp* first = NULL;
  TNexp* last  = NULL;

  for (;old!= NULL; old = old->next){
    new = newnexp();
    if (first == NULL)
      first = new;
    if (last != NULL)
      last -> next = new;

    new->exp = cpexpr (old->exp);
    last = new;
 }
 return first;
}

/*** return a copy of the expr ***/
PUBLIC Texpr*
cpexpr  (old)
	Texpr*	old;
{
  Texpr* new   = newexpr();

  new -> make     = old -> make;
  new -> type     = old -> type;
  new -> complete = old -> complete;
  new -> sorts    = old -> sorts;
  new -> opns     = old -> opns;
  new -> eqns     = old -> eqns;
  new -> fsorts   = old -> fsorts;
  new -> fopns    = old -> fopns;
  new -> feqns    = old -> feqns;
  new -> gs       = old -> gs;
  new -> go       = old -> go;

  return new;
}

/**** provides the renaming application for sorts **/
PUBLIC INTlist
getrengs (table, nexp, tline)
	INTlist table;
	TNexp*  nexp;
	int*    tline;
{
  INTlist g = NULL;
  INTlist processed = NULL;
  INTlist gaux ;
  Texpr*  exp;
  TATTR*  att;
  int     element;
  int     name;
  int     uid;

  /* go through the list of components of the type */
  for (; nexp != NULL; nexp = nexp -> next){
    exp = nexp->exp;
    for (gaux = exp->gs ; gaux!=NULL ; gaux=INTtail(INTtail(gaux))){
      element = INThead (INTtail(gaux));
      if (!isinlist (element,processed)){
	if (0!=(name = isnameinlist(table,(int)ATable->data[element].value1))){
	  uid    = ATinc (ATable);

	  ATset (ATable,uid,c_line, (CLR_TYPE)tline);

	  if (NULL != (att = ATfind (ATable, element, c_lexical)))
	    ATset (ATable,uid,c_lexical,att ->value);
	  if (NULL != (att = ATfind (ATable, element, c_name)))
	    ATset (ATable,uid,c_name,att ->value);
	  if (NULL != (att = ATfind (ATable, element, c_parse)))
	    ATset (ATable,uid, c_parse, att->value);
	  if (NULL != (att = ATfind (ATable, element, c_draw)))
	    ATset (ATable,uid, c_draw, att->value);
	  if (NULL != (att = ATfind (ATable, element, c_equal)))
	    ATset (ATable,uid,c_equal,att->value);
	  if (NULL != (att = ATfind (ATable, element, c_extern)))
	    ATset (ATable,uid,c_extern,att->value);
	  if (NULL != (att = ATfind (ATable, element, c_free)))
	    ATset (ATable,uid, c_free,att->value);
	  if (NULL != (att = ATfind (ATable, element, c_copy)))
	    ATset (ATable,uid, c_copy,att->value);
	  if (NULL != (att = ATfind (ATable, element, c_type)))
	    ATset (ATable,uid, c_type,att->value);
	  if (NULL != (att = ATfind (ATable, element, c_nocopy)))
	    ATset (ATable,uid,c_nocopy,att->value);
	  if (NULL != (att = ATfind (ATable, element, c_nofree)))
	    ATset (ATable,uid,c_nofree,att->value);
	  if (NULL != (att = ATfind (ATable, element, c_nodraw)))
	    ATset (ATable,uid,c_nodraw,att->value);
	  if (NULL != (att = ATfind (ATable, element, c_noparse)))
	    ATset (ATable,uid,c_noparse,att->value);


	  ATable->data[uid].value1 = (CLR_TYPE) name;
	  if ((int)ATable->data[element].value0 == TSORT){
	    ATable->data[uid].value0 = (CLR_TYPE) TSORT;
	    ATset (ATable, uid, c_ui, (CLR_TYPE)sort_unique++);
	  } else {
	    ATable->data[uid].value0 = (CLR_TYPE) TFSORT;
	    ATset (ATable, uid, c_ui, (CLR_TYPE)fsort_unique++);
	  }
	  g = INTcons (uid, g);
	} else
	  g = INTcons (element, g);
	g = INTcons (element, g);
      }
      processed = INTcons(element, processed);
    }
  }
  return g;
}

/**** provides the renaming application for operations **/
PUBLIC INTlist
getrengop (table, nexp, gs, tline)
	INTlist table;
	TNexp*  nexp;
	INTlist gs;
	int*    tline;
{
  INTlist g = NULL;
  INTlist processed = NULL;
  INTlist gaux;
  INTlist argl;
  INTlist sargl;
  TATTR*  att;
  Texpr*  exp;
  int     sort;
  int	  newname;
  int	  dest;
  int	  org;
  int	  uid;

  /* go through the list of components of the type */
  for (; nexp != NULL; nexp = nexp -> next){
    exp = nexp->exp;
    for (gaux = exp->go ; gaux!=NULL ; gaux=INTtail(INTtail(gaux))){
      org = INThead (gaux);
      dest = INThead (INTtail(gaux));
      if ((dest > 0) && (org > 0) &&(!isinlist (dest,processed))){
	if ((newname=isnameinlist(table,(int)ATable->data[dest].value1))!= 0){
	  uid    = ATinc (ATable);

	  ATset (ATable,uid,c_line,(CLR_TYPE)tline);

	  if (NULL != (att = ATfind (ATable, dest, c_call)))
	    ATset (ATable,uid,c_call,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_lexical)))
	    ATset (ATable,uid,c_lexical,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_lexicalifpossible)))
	    ATset (ATable,uid,c_lexicalifpossible,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_internal)))
	    ATset (ATable,uid,c_internal,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_using)))
	    ATset (ATable,uid,c_using,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_usingsort)))
	    ATset (ATable,uid,c_usingsort,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_constructor)))
	    ATset (ATable,uid,c_constructor,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_nonconstructor)))
	    ATset (ATable,uid,c_nonconstructor,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_name)))
	    ATset (ATable,uid,c_name,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_extern)))
	    ATset (ATable,uid,c_extern,att ->value);
	  if (NULL != (att = ATfind (ATable, dest, c_partial)))
	    ATset (ATable,uid,c_partial,att ->value);

	  ATable->data[uid].value1 = (CLR_TYPE) newname;
	  if ((int)ATable->data[dest].value0 == TOPN){
	    ATable->data[uid].value0 = (CLR_TYPE) TOPN;
	    ATset (ATable, uid, c_ui, (CLR_TYPE)opns_unique++);
	  } else {
	    ATable->data[uid].value0 = (CLR_TYPE) TFOPN;
	    ATset (ATable, uid, c_ui, (CLR_TYPE)fopns_unique++);
	  }

	  sargl=gslist(gs,(INTlist)ATfind(ATable,dest,c_argl)->value);
	  ATset (ATable, uid, c_argl,(CLR_TYPE)sargl);
	  ATset (ATable, uid, c_sort,
		 (CLR_TYPE)gselem(gs,(int) ATfind(ATable,dest,c_sort)->value)
		);
	  ATset (ATable, uid, c_nar, ATfind(ATable,dest,c_nar)->value);

	  ATset (ATable, uid, c_sargl,(CLR_TYPE)sargl);

	  if (ATfind(ATable,dest,c_infix) != NULL)
	    ATset (ATable, uid, c_infix, (CLR_TYPE)0);
	  g = INTcons (dest, INTcons(uid, g));
	} else{
	  argl = (INTlist)ATfind(ATable,dest,c_argl)->value;
	  sort = (int)ATfind(ATable,dest,c_sort)->value;
	  if ((INTcmp (argl, gslist(gs,argl)) == TRUE) &&
	      (sort == gselem(gs,sort)))
	    g = INTcons (dest, INTcons(dest, g));
	  else{
	    uid    = ATinc (ATable);

	    ATset (ATable,uid,c_line,(CLR_TYPE)tline);

	    if (NULL != (att = ATfind (ATable, dest, c_call)))
	      ATset (ATable,uid,c_call,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_lexical)))
	      ATset (ATable,uid,c_lexical,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_lexicalifpossible)))
	      ATset (ATable,uid,c_lexicalifpossible,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_internal)))
	      ATset (ATable,uid,c_internal,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_using)))
	      ATset (ATable,uid,c_using,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_usingsort)))
	      ATset (ATable,uid,c_usingsort,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_constructor)))
	      ATset (ATable,uid,c_constructor,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_nonconstructor)))
	     ATset (ATable,uid,c_nonconstructor,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_name)))
	      ATset (ATable,uid,c_name,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_extern)))
	      ATset (ATable,uid,c_extern,att ->value);
	    if (NULL != (att = ATfind (ATable, dest, c_partial)))
	      ATset (ATable,uid,c_partial,att ->value);

	    ATable->data[uid].value1 = ATable->data[dest].value1;
	    if ((int)ATable->data[dest].value0 == TOPN){
	      ATable->data[uid].value0 = (CLR_TYPE) TOPN;
	      ATset (ATable, uid, c_ui, (CLR_TYPE)opns_unique++);
	    } else {
	      ATable->data[uid].value0 = (CLR_TYPE) TFOPN;
	      ATset (ATable, uid, c_ui, (CLR_TYPE)fopns_unique++);
	    }

	    sargl=gslist(gs,argl);
	    ATset (ATable,uid,c_argl,(CLR_TYPE)sargl);
	    ATset (ATable,uid,c_sort,(CLR_TYPE)gselem(gs,sort));
	    ATset (ATable,uid,c_nar,(CLR_TYPE)ATfind(ATable,dest,c_nar)->value);

	    ATset (ATable,uid,c_sargl,(CLR_TYPE)sargl);

	    if (ATfind(ATable,dest,c_infix) != NULL)
	      ATset (ATable, uid, c_infix, (CLR_TYPE)0);
	    g = INTcons (dest, INTcons (uid, g));
	  }
	}
      }
      processed = INTcons(dest, processed);
    }
  }
  return g;
}

/*** apply the renaming to an exp ***/
PUBLIC TNexp*
rnexp   (gs, gop, nexp)
	INTlist gs;
	INTlist gop;
	TNexp*  nexp;
{
  INTlist auxg = NULL;
  INTlist newgs = NULL;
  INTlist newgo = NULL;
  Texpr*  exp;
  Texpr*  auxexp;
  TNexp*  ornexp;
  int     modify;
  int     newval;

  ornexp = nexp;
  for (; nexp  != NULL; nexp = nexp -> next){
    exp = nexp -> exp;
    modify = FALSE;
    for (auxg = exp->gs;
	 (auxg != NULL) && (modify == FALSE);
	 auxg = INTtail (INTtail (auxg))){
      newval = findnew (INThead (auxg), newgs);
      if (newval != INThead (auxg))
	modify = TRUE;
    }
    for (auxg = exp->go;
	 (auxg != NULL) && (modify == FALSE);
	 auxg = INTtail (INTtail (auxg))){
      newval = findnew ( INThead (auxg), newgo);
      if (newval != INThead (auxg))
	modify = TRUE;
    }

    if (modify == TRUE){
      auxexp = cpexpr (exp);
      auxexp -> complete = FALSE;
      for (auxg = auxexp->gs; auxg != NULL; auxg = INTtail (INTtail (auxg))){
	newval = findnew ( INThead (auxg), newgs);
	newgs = INTcons (newval, INTcons(INThead (auxg), newgs));
      }
      for (auxg = auxexp->go; auxg != NULL; auxg = INTtail (INTtail (auxg))){
	newval = findnew ( INThead (auxg), newgo);
	newgo = INTcons (newval, INTcons(INThead (auxg), newgo));
      }
      auxexp ->gs = newgs;
      auxexp ->go = newgo;
    }
  }
  return ornexp;
}

/** gets the list of declared elements for the "class" */
PUBLIC INTlist
gdecs (nexp, class)
	TNexp* nexp;
	int    class;
{
  INTlist auxg = NULL;
  INTlist result = NULL;
  TNexp*  auxexp;
  int     val,i;

  if (tproc < ATable->size+1){
    if (tproc == 0)
      procesed=(int*)malloc((unsigned)((BUCKSIZE+ATable->size)*(sizeof(int))));
    else
      procesed=(int*)realloc((char*)procesed,
			   (unsigned)((BUCKSIZE+ATable->size)*(sizeof(int))));
    if (procesed == NULL){
      (void) fprintf (stderr,"lsa: not enough memory\n");
       exit (1);
    }

    tproc = ATable->size+BUCKSIZE;
  }
  for  (i= 1; i<=ATable->size; i++)
    procesed[i] = 0;

  switch (class){
    case TSORT:
      for (auxexp=nexp; auxexp  != NULL; auxexp = auxexp -> next){
	auxg = auxexp->exp->gs;
	for (; auxg != NULL; auxg = INTtail (INTtail (auxg))){
	  val = INThead (INTtail (auxg));
	  if ((procesed[val]==0) && ((int)ATable->data[val].value0 == TSORT)){
	    result = INTcons (val, result);
	    procesed[val] = 1;
	  }
	}
      }
      break;
    case TFSORT:
      for (auxexp=nexp; auxexp  != NULL; auxexp = auxexp -> next){
	auxg = auxexp->exp->gs;
	for (; auxg != NULL; auxg = INTtail (INTtail (auxg))){
	  val = INThead (INTtail (auxg));
	  if (((int)ATable->data[val].value0 == TFSORT)&&(procesed[val]==0)){
	    result = INTcons (val, result);
	    procesed[val] = 1;
	  }
	}
      }
      break;
    case TOPN:
      for (auxexp=nexp; auxexp  != NULL; auxexp = auxexp -> next){
	auxg  = auxexp->exp->go;
	for (; auxg != NULL; auxg = INTtail (INTtail (auxg))){
	  val = INThead (INTtail (auxg));
	  if ((procesed[val]== 0) &&((int)ATable->data[val].value0 == TOPN)){
	    result = INTcons (val, result);
	    procesed[val] = 1;
	  }
	}
      }
      break;
    case TFOPN:
      for (auxexp=nexp; auxexp  != NULL; auxexp = auxexp -> next){
	auxg  = auxexp->exp->go;
	for (; auxg != NULL; auxg = INTtail (INTtail (auxg))){
	  val = INThead (INTtail (auxg));
	  if (((int)ATable->data[val].value0 == TFOPN)&& (procesed[val]==0)){
	    result = INTcons (val, result);
	    procesed[val] = 1;
	  }
	}
      }
      break;
    default:
	  (void) fprintf (stderr,"lsa: fatal error\n\n");
	  exit(1);
  }
  return result;
}

/**** provides the actualization application for operations **/
PUBLIC INTlist
getactgop (type, replace, gs, FOP1, OP_FOP1, FOP2, OP_FOP2, tline)
	int     type;
	INTlist replace;
	INTlist gs;
	INTlist FOP1;
	INTlist OP_FOP1;
	INTlist FOP2;
	INTlist OP_FOP2;
	int*    tline;
{
  INTlist aux;
  INTlist aux2;
  INTlist gop = NULL; /* org, des */
  INTlist processed= NULL;
  INTlist gargs;
  int     gres;
  INTlist args;
  int     res;
  int     pos;
  INTlist args2;
  int     res2;
  int     pos2;
  int     name;
  int     newname;
  int     found1;
  int	  uid;
  int     uidaux;
  int     uidaux2;
  TATTR*  att;

  for (aux = FOP1 ; aux != NULL; aux = INTtail (aux)){
    uidaux = INThead (aux);
    if ((uidaux > 0)&& (!isinlist (uidaux, processed))){
      name = (int) ATable->data[uidaux].value1;
      if (0==(newname=isnameinlist (replace, name)))
	newname = name; /* is new name for renaming application */

      args = (INTlist) ATfind (ATable, uidaux, c_argl) -> value;
      res  = (int)     ATfind (ATable, uidaux, c_sort) -> value;
      if ( ATfind (ATable, uidaux, c_infix) != NULL)
	pos = infix;
      else
	pos = prefix;

      gres = gselem (gs, res);
      gargs= gslist (gs, args);

      found1 = FALSE;
      /* looks for an operation equal to the resulting actualization */
      for (aux2 = FOP2; (found1 == FALSE)&&(aux2 != NULL); aux2=INTtail(aux2)){
	uidaux2 = INThead (aux2);
	if (uidaux2 > 0){
	  if (newname == (int) ATable->data[INThead (aux2)].value1){
	    args2= (INTlist) ATfind (ATable, INThead (aux2), c_argl) -> value;
	    res2 = (int)     ATfind (ATable, INThead (aux2), c_sort) -> value;
	    if ( ATfind (ATable, INThead (aux2), c_infix) != NULL)
	      pos2 = infix;
	    else
	      pos2 = prefix;
	    if ((pos == pos2) && (gres==res2) && (INTcmp(gargs, args2)==TRUE)){
	      gop = INTcons (INThead (aux), INTcons (INThead(aux2), gop));
	      found1 = TRUE;
	    }
	  }
	}
      }
      for (aux2 = OP_FOP2;(found1 == FALSE)&&(aux2 != NULL);aux2=INTtail(aux2)){
	uidaux2 = INThead (aux2);
	if (uidaux2 > 0){
	  if (newname == (int) ATable->data[INThead (aux2)].value1){
	    args2= (INTlist) ATfind (ATable, INThead (aux2), c_argl) -> value;
	    res2 = (int)     ATfind (ATable, INThead (aux2), c_sort) -> value;
	    if ( ATfind (ATable, INThead (aux2), c_infix) != NULL)
	      pos2 = infix;
	    else
	      pos2 = prefix;
	    if ((pos == pos2)&&(gres == res2)&&(INTcmp(gargs, args2) == TRUE)){
	      gop = INTcons (INThead (aux), INTcons (INThead(aux2), gop));
	      found1 = TRUE;
	    }
	  }
	}
      }
      /* If it is not found UNDEF is the result of the actualization */
      if (found1 == FALSE)
	gop = INTcons (INThead(aux), INTcons (UNDEF, gop));
    }
    processed = INTcons (uidaux, processed);
  }
  /* renaming fo the non formal operations */
  for (aux = OP_FOP1; aux != NULL ; aux = INTtail (aux)){
    uidaux = INThead (aux);
    if ((uidaux > 0)&& (!isinlist (uidaux, processed))){
      name = (int) ATable->data[uidaux].value1;

      args = (INTlist) ATfind (ATable, uidaux, c_argl) -> value;
      res  = (int)     ATfind (ATable, uidaux, c_sort) -> value;
      if ( ATfind (ATable, uidaux, c_infix) != NULL)
	pos = infix;
      else
	pos = prefix;

      gres = gselem (gs, res);
      gargs= gslist (gs, args);

      if (0!= (newname=isnameinlist (replace, name))){
	/* If it is in the replacement list */
	uid = ATinc (ATable);

	ATset (ATable,uid,c_line, (CLR_TYPE)tline);

	if (NULL != (att = ATfind (ATable, uidaux, c_call)))
	  ATset (ATable,uid,c_call,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_lexical)))
	  ATset (ATable,uid,c_lexical,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_lexicalifpossible)))
	  ATset (ATable,uid,c_lexicalifpossible,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_internal)))
	  ATset (ATable,uid,c_internal,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_using)))
	  ATset (ATable,uid,c_using,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_usingsort)))
	  ATset (ATable,uid,c_usingsort,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_constructor)))
	  ATset (ATable,uid,c_constructor,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_nonconstructor)))
	   ATset (ATable,uid,c_nonconstructor,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_name)))
	  ATset (ATable,uid,c_name,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_extern)))
	  ATset (ATable,uid,c_extern,att ->value);
	if (NULL != (att = ATfind (ATable, uidaux, c_partial)))
	  ATset (ATable,uid,c_partial,att ->value);

	ATable->data[uid].value0 =  (CLR_TYPE) TOPN;
	ATable->data[uid].value1 =  (CLR_TYPE) newname;
	/* insert in the ATable the unique identifier for class */
	 ATset (ATable, uid, c_ui, (CLR_TYPE)opns_unique++);

	/* insert in the ATable the operation related information */
	ATset (ATable, uid, c_argl, (CLR_TYPE)gargs);
	ATset (ATable, uid, c_sort, (CLR_TYPE)gres);
	ATset (ATable, uid, c_nar, (CLR_TYPE)INTlength(gargs));

	ATset (ATable, uid, c_sargl, (CLR_TYPE)gargs);

	if (pos == infix)
	  ATset (ATable, uid, c_infix, (CLR_TYPE)0);

	gop = INTcons (uidaux, INTcons (uid, gop));
      }else{ /* It is not in the replacement list */
	args = (INTlist) ATfind (ATable, uidaux, c_argl) -> value;
	res  = (int)     ATfind (ATable, uidaux, c_sort) -> value;
	if ( ATfind (ATable, uidaux, c_infix) != NULL)
	  pos = infix;
	else
	  pos = prefix;

	gres = gselem (gs, res);
	gargs= gslist (gs, args);

	if ((res == gres)&&(INTcmp (args, gargs) == TRUE)){
	  /* The resulting renaming is the same operation */
	  gop = INTcons (uidaux, INTcons (uidaux, gop));
	  found1 = TRUE;
	} else {
	  /* The resulting renaming is not  the same operation */
	  uid = ATinc (ATable);

	  ATset (ATable,uid,c_line, (CLR_TYPE)tline);;

	  if (NULL != (att = ATfind (ATable, uidaux, c_call)))
	    ATset (ATable,uid,c_call,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_lexical)))
	    ATset (ATable,uid,c_lexical,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_lexicalifpossible)))
	    ATset (ATable,uid,c_lexicalifpossible,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_internal)))
	    ATset (ATable,uid,c_internal,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_using)))
	    ATset (ATable,uid,c_using,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_usingsort)))
	    ATset (ATable,uid,c_usingsort,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_constructor)))
	    ATset (ATable,uid,c_constructor,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_nonconstructor)))
	    ATset (ATable,uid,c_nonconstructor,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_name)))
	    ATset (ATable,uid,c_name,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_extern)))
	    ATset (ATable,uid,c_extern,att ->value);
	  if (NULL != (att = ATfind (ATable, uidaux, c_partial)))
	    ATset (ATable,uid,c_partial,att ->value);

	  ATable->data[uid].value0 =  (CLR_TYPE) TOPN;
	  ATable->data[uid].value1 =  (CLR_TYPE) name;
	  /* insert in the ATable the unique identifier for class */
	  ATset (ATable, uid, c_ui, (CLR_TYPE)opns_unique++);

	  /* insert in the ATable the operation related information */
	  ATset (ATable, uid, c_argl, (CLR_TYPE)gargs);
	  ATset (ATable, uid, c_sort, (CLR_TYPE)gres);
	  ATset (ATable, uid, c_nar, (CLR_TYPE)INTlength(gargs));

	  ATset (ATable, uid, c_sargl, (CLR_TYPE)gargs);

	  if (pos == infix)
	    ATset (ATable, uid, c_infix, (CLR_TYPE)0);

	  gop = INTcons (uidaux, INTcons (uid, gop));
	}
      }
    }
    processed = INTcons (uidaux, processed);
  }
  return gop;
}

/**** provides the actualization application for sorts **/
PUBLIC INTlist
getactgs (type, replace, FS1, S_FS1, FS2, S_FS2, tline)
	int	type;
	INTlist	replace;
	INTlist	FS1;
	INTlist	S_FS1;
	INTlist	FS2;
	INTlist	S_FS2;
	int*	tline;
{
  INTlist aux;
  INTlist aux2;
  INTlist gs=NULL; /* org, dest */
  TATTR*  att;
  int     name;
  int     newname;
  int     found1;
  int	  uid;
  int     element;

  for ( aux = FS1 ; aux != NULL; aux = INTtail (aux)){
    found1 = FALSE;
    name = (int) ATable->data[INThead (aux)].value1;
    if (0==(newname=isnameinlist (replace, name)))
      newname = name;
    for (aux2= S_FS2; (found1== FALSE) && (aux2 != NULL); aux2 = INTtail(aux2)){
      if ( (int) ATable->data[INThead (aux2)].value1 ==  newname){
	gs = INTcons (INThead (aux), INTcons (INThead (aux2), gs));
	found1 = TRUE;
      }
    }
    for (aux2= FS2; (found1== FALSE) && (aux2 != NULL); aux2 = INTtail (aux2)){
      if ( (int) ATable->data[INThead (aux2)].value1 ==  newname){
	gs = INTcons (INThead (aux), INTcons (INThead (aux2), gs));
	found1 = TRUE;
      }
    }
    if (found1 == FALSE)
      gs = INTcons (INThead (aux), INTcons (UNDEF, gs));
  }
  for ( aux = S_FS1 ; aux != NULL; aux = INTtail (aux)){
    element = INThead(aux);
    name = (int) ATable->data[element].value1;
    if (0!=(newname=isnameinlist (replace, name))){
      uid = ATinc (ATable);

      ATset (ATable,uid,c_line, (CLR_TYPE)tline);

      if (NULL != (att = ATfind (ATable, element, c_lexical)))
	ATset (ATable,uid,c_lexical,att ->value);
      if (NULL != (att = ATfind (ATable, element, c_name)))
	ATset (ATable,uid,c_name,att ->value);
      if (NULL != (att = ATfind (ATable, element, c_draw)))
	ATset (ATable,uid, c_draw, att->value);
      if (NULL != (att = ATfind (ATable, element, c_parse)))
	ATset (ATable,uid, c_parse, att->value);
      if (NULL != (att = ATfind (ATable, element, c_equal)))
	ATset (ATable,uid,c_equal,att->value);
      if (NULL != (att = ATfind (ATable, element, c_extern)))
	ATset (ATable,uid,c_extern,att->value);
      if (NULL != (att = ATfind (ATable, element, c_free)))
	ATset (ATable,uid, c_free,att->value);
      if (NULL != (att = ATfind (ATable, element, c_copy)))
	ATset (ATable,uid, c_copy,att->value);
      if (NULL != (att = ATfind (ATable, element, c_type)))
	ATset (ATable,uid, c_type,att->value);
      if (NULL != (att = ATfind (ATable, element, c_nocopy)))
	ATset (ATable,uid,c_nocopy,att->value);
      if (NULL != (att = ATfind (ATable, element, c_nofree)))
	ATset (ATable,uid,c_nofree,att->value);
      if (NULL != (att = ATfind (ATable, element, c_nodraw)))
	ATset (ATable,uid,c_nodraw,att->value);
      if (NULL != (att = ATfind (ATable, element, c_noparse)))
	ATset (ATable,uid,c_noparse,att->value);


      ATable->data[uid].value0 =  (CLR_TYPE) TSORT;
      ATable->data[uid].value1 =  (CLR_TYPE) newname;
      /* insert in the ATable the unique identifier for class */
      ATset (ATable, uid, c_ui, (CLR_TYPE)sort_unique++);

      gs = INTcons (element, INTcons (uid, gs));
    } else
      gs = INTcons (element, INTcons (element, gs));
  }

  return gs;
}

/** append a copy af a new exp to an old exp */
PUBLIC TNexp*
expappend (old, new, mknew)
	TNexp*	old;
	TNexp*	new;
	int     mknew;
{
  TNexp* last;
  TNexp* aux;
  TNexp* aux2;
  TNexp* newl = NULL;
  TNexp* firstn = NULL;

  if (old == NULL)
    if (mknew)
      return cpnexp(new);
    else
      return new;

  for (last = old; last->next != NULL; last = last -> next);

  if (mknew){
    for (aux = new; aux!= NULL; aux = aux->next){
      for (aux2 = old;
	   (aux2 != NULL)&& (aux2->exp != aux->exp);
	   aux2 = aux2 -> next);
      if (aux2 == NULL){
	if (newl == NULL){
	  newl = newnexp();
	  firstn= newl;
	  newl->exp = aux->exp;
	} else {
	  newl->next = newnexp();
	  newl= newl->next;
	  newl->exp = aux->exp;
	}
      }
    }
    last -> next = firstn;
  }else
    last -> next = new;

  return old;
}


/**  gets the exp of a type */
PUBLIC TNexp*
getexp (type, tiddec)
	int type;
	int tiddec;
{
  TNODE*  address;
  TNexp*  nexp;
  INTlist deps;
  INTlist tdeps;
  int     loop;

  if (type <= 0)
    return NULL;

  address = (TNODE*) ATfind (ATable, type, c_addr)->value;
  deps    = (INTlist)ATfind (ATable, type, c_deps)->value;
  if (type == tiddec){
    report (address, c_line);
    (void) fprintf(stderr,
		   "lsa: circular definition of type \"%s\" \n",
		   SymbolTable->data[(int)ATable->data[type].value1]);
   /* 7.3.4.3 a R a1 */
    (void) fprintf(stderr,
		   "\n*** lsa: cannot recover from earlier errors ***\n");
    exit (1);

  }
  if (0 != (loop = depof (tiddec, deps))){
    report (address, c_line);
    (void) fprintf(stderr,
		   "lsa: circular definition of types \"%s\" and \"%s\"\n",
		   SymbolTable->data[(int)ATable->data[loop].value1],
		   SymbolTable->data[(int)ATable->data[type].value1]);
    /* 7.3.4.3 a R a1 */
    (void) fprintf(stderr,
		   "\n*** lsa: cannot recover from earlier errors ***\n");
    exit (1);
  }
  if (tiddec >= 0){
    tdeps = (INTlist)ATfind (ATable, tiddec, c_deps)->value;
    tdeps = INTcons (type, tdeps);
    ATfind (ATable, tiddec, c_deps)-> value = (CLR_TYPE)tdeps;
  }

  nexp = (TNexp*) fdclr (c_exp, address, 1000+__LINE__ );

  return nexp;
}

PUBLIC INTlist
getdecs (gsop, type)
	INTlist gsop;
	int     type;
{
  INTlist decs = NULL;

  if (gsop == NULL)
    return NULL;

  for (; gsop != NULL; gsop = INTtail (INTtail (gsop)))
    if ((int)ATable->data[INThead (INTtail(gsop))].value0 == type)
      if (!isinlist (INThead (INTtail(gsop)),decs))
	decs = INTcons (INThead (INTtail(gsop)), decs);

  return decs;

}

/* builts the new expression resulting from a renaming */
PUBLIC TNexp*
rengsop (oldexp, gs, go)
	TNexp*	oldexp;
	INTlist gs;
	INTlist go;
{
  TNexp*  auxnexp;
  Texpr*  auxexpr;
  Texpr*  nexpr;
  TNexp*  first;
  INTlist auxg;
  INTlist ng;
  int     org, dest;
  int	  modify;

  first  = cpnexp (oldexp);
  for (auxnexp = first; auxnexp != NULL; auxnexp = auxnexp->next){
    auxexpr = auxnexp->exp;
    modify = FALSE;

    auxg = auxexpr->gs;
    for (;(auxg!= NULL) && (modify == FALSE); auxg = INTtail(INTtail(auxg))){
      org = INThead(INTtail(auxg));
      dest = applyg (gs, org);
      if (org != dest)
	modify = TRUE;
    }
    auxg = auxexpr->go;
    for (;(auxg!= NULL) && (modify == FALSE); auxg = INTtail(INTtail(auxg))){
      org = INThead(INTtail(auxg));
      dest = applyg (go, org);
      if (org != dest)
	modify = TRUE;
    }

    if (modify == TRUE){
      nexpr=cpexpr(auxexpr);
      nexpr->complete = FALSE;
      auxg = nexpr->gs;
      ng = NULL;
      for (;auxg!= NULL; auxg = INTtail(INTtail(auxg))){
	org = INThead(INTtail(auxg));
	dest = applyg (gs, org);
	ng = INTcons (INThead(auxg), INTcons(dest,ng));
      }
      nexpr -> gs = ng;
      auxg = nexpr->go;
      ng = NULL;
      for (;auxg!= NULL; auxg = INTtail(INTtail(auxg))){
	org = INThead(INTtail(auxg));
	dest = applyg (go, org);
	ng = INTcons (INThead(auxg), INTcons(dest,ng));
      }
      nexpr -> go = ng;

      auxnexp ->exp= nexpr;
    }
  }
  return first;
}

/* builts the new expression resulting from a renaming */
PUBLIC TNexp*
actgsop (nexp1, nexp2, gs, go)
	TNexp*	nexp1;
	TNexp*	nexp2;
	INTlist gs;
	INTlist go;
{
  TNexp*  auxnexp;
  TNexp*  first;
  Texpr*  auxexpr;
  Texpr*  nexpr;
  INTlist auxg;
  INTlist ng;
  int     org, dest;
  int     modify;

  if (nexp1==NULL)
    return NULL;

  first  = cpnexp (nexp1);
  for (auxnexp = first; auxnexp != NULL; auxnexp = auxnexp->next){
    modify = FALSE;

    auxexpr = auxnexp->exp;
    auxexpr -> fsorts = NULL;
    auxexpr -> fopns  = NULL;
    auxexpr -> feqns  = NULL;

    auxg = auxexpr->gs;
    for (;auxg!= NULL; auxg = INTtail(INTtail(auxg))){
      org = INThead(INTtail(auxg));
      dest = applyg (gs, org);
      if (org != dest)
	modify = TRUE;
    }
    auxg = auxexpr->go;
    for (;auxg!= NULL; auxg = INTtail(INTtail(auxg))){
      org = INThead(INTtail(auxg));
      dest = applyg (go, org);
      if (org != dest)
	modify = TRUE;
    }

    if (modify == TRUE){
      nexpr = cpexpr (auxexpr);
      nexpr->complete = FALSE;
      auxg = nexpr->gs;
      ng = NULL;
      for (;auxg!= NULL; auxg = INTtail(INTtail(auxg))){
	org = INThead(INTtail(auxg));
	dest = applyg (gs, org);
	ng = INTcons (INThead(auxg), INTcons(dest,ng));
      }
      nexpr -> gs = ng;
      auxg = nexpr->go;
      ng = NULL;
      for (;auxg!= NULL; auxg = INTtail(INTtail(auxg))){
	org = INThead(INTtail(auxg));
	dest = applyg (go, org);
	ng = INTcons (INThead(auxg), INTcons(dest,ng));
      }
      nexpr -> go = ng;

      auxnexp -> exp = nexpr;

    }
  }

  for (auxnexp= first; auxnexp->next != NULL; auxnexp= auxnexp->next);
  auxnexp->next = nexp2;

  return first;
}


/* functionality functions */

/* min -- eval the min functionality */
PUBLIC INTlist
minfunc (func1, func2)
	INTlist func1;
	INTlist func2;
{
  INTlist  f1;
  INTlist  f2;

  if (func1 == NULL){
    if (func2 == NULL)
      return NULL;
    else if (INThead(func2) == 0)
	      return INTcons(0,(INTlist)NULL);
	 else return INTcons(-1,(INTlist)NULL);
  }else if (func2 == NULL) {
    if (INThead(func1) == 0)
      return INTcons(0,(INTlist)NULL);
    else return INTcons(-1,(INTlist)NULL);
  }else {
    if ((INThead(func1) == 0)||
	(INThead(func2) == 0))
      return INTcons(0,(INTlist)NULL);
    f1 = func1;
    f2 = func2;
    while ((f1!=NULL)&&(f2!=NULL)){
      if (INThead(f1) != INThead(f2))
       return INTcons(-1,(INTlist)NULL);
      f1= INTtail(f1);
      f2= INTtail(f2);
    }
    if ((f1==NULL)&&(f2==NULL))
	return func1;
    else return INTcons(-1,(INTlist)NULL);
  }
} /* end of minfunc */

/* max -- eval the max functionality */
PUBLIC INTlist
maxfunc (func1, func2)
	INTlist func1;
	INTlist func2;
{
  INTlist  f1;
  INTlist  f2;

  if (func1 == NULL) {
    if (func2 == NULL)
	 return NULL;
    else if (INThead(func2) == 0)
	      return NULL;
	 else return INTcons(-1,(INTlist)NULL);
  }else if (func2 == NULL) {
    if (INThead(func1) == 0)
      return NULL;
    else return INTcons(-1,(INTlist)NULL);
  }else{
    if (INThead(func1) == 0)
      return func2;
    if (INThead(func2) == 0)
      return func1;

    f1 = func1;
    f2 = func2;
    while ((f1!=NULL)&&(f2!=NULL)){
      if (INThead(f1) != INThead(f2))
       return INTcons(-1,(INTlist)NULL);
      f1= INTtail(f1);
      f2= INTtail(f2);
    }
    if ((f1==NULL)&&(f2==NULL))
	return func1;
    else return INTcons(-1,(INTlist)NULL);
  }
} /* end of maxfunc */

PUBLIC int
tdif	(types)
	INTlist types;
{
  INTlist auxt;
  int     name;
  int     errors;
  char*   sep = ", ";

  errors = FALSE;
  trdecs = (char*) malloc (2);
  if (trdecs == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  trdecs = strcpy (trdecs, " ");
  for (; types != NULL; types = INTtail (types)){
    name = (int)ATable->data[INThead(types)].value1;
    for (auxt = INTtail (types); auxt != NULL ;auxt = INTtail (auxt)){
      if (name == (int)ATable->data[INThead(auxt)].value1){
	if (strlen(trdecs) != 1){
	  trdecs = realloc (trdecs, (unsigned)(2+strlen (trdecs)));
	  if (trdecs == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  trdecs = strcat (trdecs, sep);
	}
	trdecs=realloc(trdecs,
		   (unsigned)(strlen (trdecs)+strlen(SymbolTable->data[name])));
	if (trdecs == NULL){
	  (void)fprintf(stderr,"lsa: not enough memory\n");
	  exit(1);
	}
	trdecs=strcat (trdecs, SymbolTable->data[name]);
	errors=TRUE;
	break;
      }
    }
  }

  return (! errors);
}

PUBLIC int
pdif	(types)
	INTlist types;
{
  INTlist auxt;
  int     name;
  int     errors;
  char*   sep = ", ";

  prdecs = (char*) malloc (2);
  if (prdecs == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  prdecs = strcpy (prdecs, " ");
  for (; types != NULL; types = INTtail (types)){
    name = (int)ATable->data[INThead(types)].value1;
    for (auxt = INTtail (types); auxt != NULL ;auxt = INTtail (auxt)){
      if (name == (int)ATable->data[INThead(auxt)].value1){
	if (strlen(prdecs) != 1){
	  prdecs = realloc (prdecs, (unsigned)(2+strlen (prdecs)));
	  if (prdecs == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  prdecs = strcat (prdecs, sep);
	}
	prdecs=realloc(prdecs,
		    (unsigned)(strlen(prdecs)+strlen(SymbolTable->data[name])));
	if (prdecs == NULL){
	  (void)fprintf(stderr,"lsa: not enough memory\n");
	  exit(1);
	}
	prdecs = strcat (prdecs, SymbolTable->data[name]);
	errors = TRUE;
	break;
      }
    }
  }

  return (! errors);
}

PUBLIC int
sdif	(scp)
	TNscp* scp;
{
  INTlist slist;
  TNentry*  auxe;
  int     sort;
  int     sname;
  int     errors;
  char*   sep = ", ";

  errors = FALSE;
  srdecs = (char*) malloc (2);
  if (srdecs == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  srdecs = strcpy (srdecs, " ");
  for (auxe= scp->next; auxe != NULL; auxe = auxe->next){
    if (auxe-> class == TSORT){
      for (slist = auxe->decs; slist != NULL; slist = INTtail (slist)){
	if ((sort = INThead (slist)) > 0){
	  sname = (int)ATable->data[sort].value1;
	  if (sortover (sort, sname, auxe)){
	    if (strlen(srdecs) != 1){
	      srdecs = realloc (srdecs, (unsigned)(2+strlen (srdecs)));
	      if (srdecs == NULL){
		(void)fprintf(stderr,"lsa: not enough memory\n");
		exit(1);
	      }
	      srdecs = strcat (srdecs, sep);
	    }
	    srdecs = realloc (srdecs,
			      (unsigned)(strlen (srdecs)+
					 strlen(SymbolTable->data[sname])));
	    if (srdecs == NULL){
	      (void)fprintf(stderr,"lsa: not enough memory\n");
	      exit(1);
	    }
	    srdecs = strcat (srdecs, SymbolTable->data[sname]);
	    errors = TRUE;
	  }
	}
      }
    }
  }

  return (! errors);
}

PUBLIC int
odif	(scp)
	TNscp* scp;
{
  INTlist slist;
  TNentry*  auxe;
  int     opn;
  int     oname;
  int     res;
  INTlist argl;
  int     pos;
  int     errors;
  char*   sep = ", ";

  errors = FALSE;
  ordecs = (char*) malloc (2);
  if (ordecs == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  ordecs = strcpy (ordecs, " ");
  for (auxe= scp->next; auxe != NULL; auxe = auxe->next){
    if (auxe-> class == TOPN){
      for (slist = auxe->decs; slist != NULL; slist = INTtail (slist)){
	if ((opn = INThead (slist)) > 0) {
	  oname = (int)ATable->data[opn].value1;
	  argl  = (INTlist) ATfind (ATable, opn, c_argl) -> value;
	  res  = (int) ATfind (ATable, opn, c_sort) -> value;
	  if (ATfind (ATable, opn, c_infix) != NULL)
	    pos = infix;
	  else
	    pos = prefix;

	  if (opnsover (opn, oname, argl, res, pos, auxe)){
	    if (strlen(ordecs) != 1){
	      ordecs = realloc (ordecs, (unsigned)(3+strlen (ordecs)));
	      if (ordecs == NULL){
		(void)fprintf(stderr,"lsa: not enough memory\n");
		exit(1);
	      }
	      ordecs = strcat (ordecs, sep);
	    }
	    ordecs = realloc (ordecs,
			      (unsigned)(1+strlen (ordecs)+
					 strlen(SymbolTable->data[oname])));
	    if (ordecs == NULL){
	      (void)fprintf(stderr,"lsa: not enough memory\n");
	      exit(1);
	    }
	    ordecs = strcat (ordecs, SymbolTable->data[oname]);
	    errors = TRUE;
	  }
	}
      }
    }
  }

  return (! errors);
}

PUBLIC int
srdif (reps)
	INTlist reps;
{
  INTlist auxl;
  int     name;
  int     errors= FALSE;
  char*   sep = ", ";

  srep = (char*) malloc (2);
  if (srep == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  srep = strcpy (ordecs, " ");
  for ( ; reps != NULL; reps = INTtail (INTtail (reps))){
    name = INThead (reps);
    for (auxl = INTtail (INTtail(reps));
	 auxl != NULL;
	 auxl = INTtail (INTtail (auxl))){
      if (INThead(auxl) == name){
	if (strlen(srep) != 1){
	srep = realloc (srep, (unsigned)(2+strlen (srep)));
	if (srep == NULL){
	  (void)fprintf(stderr,"lsa: not enough memory\n");
	  exit(1);
	}
	srep = strcat (srep, sep);
      }
      srep = realloc(srep,
		     (unsigned)(strlen(srep)+strlen(SymbolTable->data[name])));
      if (srep == NULL){
	(void)fprintf(stderr,"lsa: not enough memory\n");
	exit(1);
      }
      srep = strcat (srep, SymbolTable->data[name]);
      errors = TRUE;
      }
    }
  }
  return (! errors);
}

PUBLIC int
getsid (name, slist)
	int     name;
	INTlist slist;
{
  for (; slist != NULL; slist = INTtail (slist)){
    if ((int)ATable->data[INThead(slist)].value1 == name)
      return INThead(slist);
  }
  return 0;
}

PUBLIC int
gdef (gsop)
	INTlist gsop;
{
  int     id;
  int     name;
  int     errors= FALSE;
  char*   sep = ", ";

  sgdef = (char*) malloc (2);
  if (sgdef == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  sgdef = strcpy (ordecs, " ");
  for (; gsop != NULL; gsop = INTtail (INTtail (gsop))){
    id = INThead (INTtail(gsop));
    if (id == UNDEF){
      if (INThead (gsop) >= 0){
	name = (int)ATable->data[INThead (gsop)].value1;
	if (strlen(sgdef) != 1){
	  sgdef = realloc (sgdef, (unsigned)(2+strlen (sgdef)));
	  if (sgdef == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  sgdef = strcat (sgdef, sep);
	}
	sgdef=realloc(sgdef,
		     (unsigned)(strlen(sgdef)+strlen(SymbolTable->data[name])));
	if (sgdef == NULL){
	  (void)fprintf(stderr,"lsa: not enough memory\n");
	  exit(1);
	}
	sgdef = strcat (sgdef, SymbolTable->data[name]);
	errors = TRUE;
      }
    }
  }
  return (! errors);
}

PUBLIC int
ginjact (rep,nf)
	INTlist rep;
	INTlist nf;
{
  INTlist auxl;
  INTlist cnames;
  INTlist cids;
  int     name;
  int     errors= FALSE;
  char*   sep = ", ";

  sginj = (char*) malloc (2);
  if (sginj == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  sginj = strcpy (ordecs, " ");
  for (; rep != NULL; rep = INTtail (INTtail (rep))){
    name = INThead (INTtail(rep));
    cnames = INTcons (INThead (rep), (INTlist) NULL);
    for (auxl=INTtail(INTtail(rep));auxl!=NULL;auxl=INTtail(INTtail(auxl))){
      if (INThead(INTtail(auxl)) == name)
	cnames = INTcons (INThead(auxl), cnames);
    }
    if (INTlength (cnames) > 1){
      for (auxl=nf;auxl!=NULL;auxl=INTtail(auxl)){
	cids = NULL;
	if (isinlist((int)ATable->data[INThead (auxl)].value1,cnames))
	  cids = INTcons (INThead (auxl), cids);
      }
      if (INTlength (cids) > 0){
	errors = TRUE;
	for (auxl=cnames;auxl!=NULL;auxl=INTtail(auxl)){
	  sginj=realloc(sginj,
		       (unsigned)(strlen(sginj)+
				  strlen(SymbolTable->data[INThead(auxl)])));
	  if (sginj == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  sginj = strcat (sginj, SymbolTable->data[name]);
	  if (INTlength(auxl) > 1){
	    sginj = realloc (sginj, (unsigned)(2+strlen (sginj)));
	    if (sginj == NULL){
	      (void)fprintf(stderr,"lsa: not enough memory\n");
	      exit(1);
	    }
	    sginj = strcat (sginj, sep);

	  }
	}
      }
    }
  }
  return (! errors);
}
PUBLIC int
ginj (rep)
	INTlist rep;
{
  INTlist auxl;
  int     name;
  int     errors= FALSE;
  char*   sep = ", ";

  sginj = (char*) malloc (2);
  if (sginj == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  sginj = strcpy (ordecs, " ");
  for (; rep != NULL; rep = INTtail (INTtail (rep))){
    name = INThead (INTtail(rep));
    for (auxl = INTtail(INTtail(rep));
	 auxl != NULL;
	 auxl = INTtail(INTtail(auxl))){
      if (INThead(INTtail(auxl)) == name){
	if (strlen(sginj) != 1){
	  sginj = realloc (sginj, (unsigned)(2+strlen (sginj)));
	  if (sginj == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  sginj = strcat (sginj, sep);
	}
	sginj=realloc(sginj,
		     (unsigned)(strlen(sginj)+strlen(SymbolTable->data[name])));
	if (sginj == NULL){
	  (void)fprintf(stderr,"lsa: not enough memory\n");
	  exit(1);
	}
	sginj = strcat (sginj, SymbolTable->data[name]);
	errors = TRUE;
      }
    }
  }
  return (! errors);
}

PUBLIC int
snover	(slist)
	INTlist slist;
{
  INTlist auxs;
  int     sname;
  int     errors;
  int     sid;
  char*   sep = ", ";

  errors = FALSE;
  ssnover = (char*) malloc (2);
  if (ssnover == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  ssnover = strcpy (ssnover, " ");
  for (; slist != NULL; slist = INTtail (slist)){
    sid   = INThead (slist);
    sname = (int) ATable->data[sid].value1;
    for (auxs = INTtail(slist);
	 auxs != NULL;
	 auxs = INTtail(auxs)){
      if ((sid != INThead (auxs)) &&
	  (sname == (int) ATable->data[INThead (auxs)].value1)){
	if (strlen(ssnover) != 1){
	  ssnover = realloc (ssnover, (unsigned)(2+strlen (ssnover)));
	  if (ssnover == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  ssnover = strcat (ssnover, sep);
	}
	ssnover=realloc(ssnover,
		  (unsigned)(strlen(ssnover)+strlen(SymbolTable->data[sname])));
	if (ssnover == NULL){
	  (void)fprintf(stderr,"lsa: not enough memory\n");
	  exit(1);
	}
	ssnover = strcat (ssnover, SymbolTable->data[sname]);
	errors = TRUE;
      }
    }
  }

  return (! errors);
}

PUBLIC int
sfnover	(fslist, slist)
	INTlist fslist;
	INTlist slist;
{
  INTlist auxs;
  int     sname;
  int     errors;
  int     sid;
  char*   sep = ", ";

  errors = FALSE;
  ssnover = (char*) malloc (2);
  if (ssnover == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  ssnover = strcpy (ssnover, " ");
  for (; fslist != NULL; fslist = INTtail (fslist)){
    sid   = INThead (fslist);
    sname = (int) ATable->data[sid].value1;
    for (auxs = slist;
	 auxs != NULL;
	 auxs = INTtail(auxs)){
      if ((sid != INThead (auxs)) &&
	  (sname == (int) ATable->data[INThead (auxs)].value1)){
	if (strlen(ssnover) != 1){
	  ssnover = realloc (ssnover, (unsigned)(2+strlen (ssnover)));
	  if (ssnover == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  ssnover = strcat (ssnover, sep);
	}
	ssnover=realloc(ssnover,
		  (unsigned)(strlen(ssnover)+strlen(SymbolTable->data[sname])));
	if (ssnover == NULL){
	  (void)fprintf(stderr,"lsa: not enough memory\n");
	  exit(1);
	}
	ssnover = strcat (ssnover, SymbolTable->data[sname]);
	errors = TRUE;
      }
    }
  }

  return (! errors);
}

PUBLIC int
opnover	(slist)
	INTlist slist;
{
  INTlist auxs;
  INTlist aux2;
  INTlist argl;
  INTlist largl;
  int     opn;
  int     oname;
  int     errors;
  int     lopn;
  int     lres;
  int     lpos;
  int     res;
  int     pos;
  int	  i;
  char*   sep = ", ";
  static  INTlist* names=NULL;

  if (names == NULL){
    names = (INTlist*)malloc ((unsigned)(SymbolTable->size+1)*sizeof (INTlist));
    if (names == NULL){
      (void) fprintf (stderr,"lsa: not enough memory\n");
      exit (1);
    }
  }
  for (i=1; i<=SymbolTable->size; i++){
    names[i]=NULL;
  }

  errors = FALSE;

  sopnover = (char*) malloc (2);
  if (sopnover == NULL) {
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  sopnover = strcpy (sopnover, " ");
  for (auxs=slist; auxs != NULL; auxs = INTtail (auxs)){
    if (INThead(auxs) > 0){
      names[(int) ATable->data[INThead(auxs)].value1] =
	INTcons (INThead(auxs),names[(int) ATable->data[INThead(auxs)].value1]);
    }
  }
  for (i=1; i<=SymbolTable->size;i++){
    auxs = names[i];
    for (; auxs != NULL; auxs = INTtail (auxs)){
      opn = INThead(auxs);
      oname = (int) ATable->data[opn].value1;
      argl  = (INTlist) ATfind (ATable, opn, c_argl) -> value;
      res   = (int) ATfind (ATable, opn, c_sort) -> value;
      if (ATfind (ATable, opn, c_infix) != NULL)
	pos = infix;
      else
	pos = prefix;
      for (aux2 = INTtail(auxs); aux2 != NULL; aux2 = INTtail(aux2)){
	lopn = INThead (aux2);
	lres = (int) ATfind (ATable, lopn, c_sort)->value;
	if (ATfind (ATable, lopn, c_infix) != NULL)
	  lpos = infix;
	else
	  lpos = prefix;
	largl = (INTlist) ATfind (ATable, lopn, c_argl)->value;
	if ((lres == res) && (lpos == pos)&& (INTcmp (largl,argl))){
	  if (strlen(sopnover) != 1){
	    sopnover = realloc (sopnover,(unsigned)(2+strlen (sopnover)));
	    if (sopnover == NULL) {
		(void)fprintf(stderr,"lsa: not enough memory\n");
	      exit(1);
	    }
	    sopnover = strcat (sopnover, sep);
	  }
	  sopnover=realloc(sopnover,
			   (unsigned)(strlen(sopnover)+
				      strlen(SymbolTable->data[oname])));
	  if (sopnover == NULL) {
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  sopnover = strcat (sopnover, SymbolTable->data[oname]);
	  errors = TRUE;
	}
      }
    }
  }

  return (! errors);
}

PUBLIC int
opfnover (opflist, oplist)
	INTlist opflist;
	INTlist oplist;
{
  INTlist auxs;
  INTlist aux2;
  INTlist argl;
  INTlist largl;
  int     opn;
  int     oname;
  int     errors;
  int     lopn;
  int     lres;
  int     lpos;
  int     res;
  int     pos;
  int	  i;
  char*   sep = ", ";
  static  INTlist* names=NULL;

  if (names == NULL){
    names = (INTlist*)malloc ((unsigned)(SymbolTable->size+1)*sizeof (INTlist));
    if (names == NULL){
      (void) fprintf (stderr,"lsa: not enough memory\n");
      exit (1);
    }
  }
  for (i=1; i<=SymbolTable->size; i++){
    names[i]=NULL;
  }

  errors = FALSE;

  sopnover = (char*) malloc (2);
  if (sopnover == NULL) {
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  sopnover = strcpy (sopnover, " ");
  for (auxs=opflist; auxs != NULL; auxs = INTtail (auxs)){
    if (INThead(auxs) > 0){
      names[(int) ATable->data[INThead(auxs)].value1] =
	INTcons (INThead(auxs),names[(int) ATable->data[INThead(auxs)].value1]);
    }
  }
  for (i=1; i<=SymbolTable->size;i++){
    auxs = names[i];
    for (; auxs != NULL; auxs = INTtail (auxs)){
      opn = INThead(auxs);
      oname = (int) ATable->data[opn].value1;
      argl  = (INTlist) ATfind (ATable, opn, c_argl) -> value;
      res   = (int) ATfind (ATable, opn, c_sort) -> value;
      if (ATfind (ATable, opn, c_infix) != NULL)
	pos = infix;
      else
	pos = prefix;
      for (aux2 = oplist; aux2 != NULL; aux2 = INTtail(aux2)){
	lopn = INThead (aux2);
	lres = (int) ATfind (ATable, lopn, c_sort)->value;
	if (ATfind (ATable, lopn, c_infix) != NULL)
	  lpos = infix;
	else
	  lpos = prefix;
	largl = (INTlist) ATfind (ATable, lopn, c_argl)->value;
	if ((lres == res) && (lpos == pos)&& (INTcmp (largl,argl))){
	  if (strlen(sopnover) != 1){
	    sopnover = realloc (sopnover,(unsigned)(2+strlen (sopnover)));
	    if (sopnover == NULL) {
		(void)fprintf(stderr,"lsa: not enough memory\n");
	      exit(1);
	    }
	    sopnover = strcat (sopnover, sep);
	  }
	  sopnover=realloc(sopnover,
			   (unsigned)(strlen(sopnover)+
				      strlen(SymbolTable->data[oname])));
	  if (sopnover == NULL) {
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  sopnover = strcat (sopnover, SymbolTable->data[oname]);
	  errors = TRUE;
	}
      }
    }
  }

  return (! errors);
}

PUBLIC int
cvals  (vals)
	INTlist	vals;
{
  INTlist  vlist;
  INTlist  aux;
  int      val;
  int      vname;
  int      errors;
  char*    sep = ", ";

  errors = FALSE;
  vcollision = (char*) malloc (2);
  if (vcollision == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  vcollision = strcpy (vcollision, " ");
  for (vlist= vals; vlist != NULL; vlist = INTtail (vlist)){
    if ((val = INThead (vlist)) > 0){
      vname = (int)ATable->data[val].value1;
      for (aux = INTtail(vlist); aux != NULL; aux = INTtail (aux))
	if (vname == (int)ATable->data[INThead(aux)].value1){
	  if (strlen(vcollision) != 1){
	    vcollision = realloc (vcollision,(unsigned)(2+strlen (vcollision)));
	    if (vcollision == NULL){
	      (void)fprintf(stderr,"lsa: not enough memory\n");
	      exit(1);
	    }
	    vcollision = strcat (vcollision, sep);
	  }
	  vcollision=realloc(vcollision,
			    (unsigned)(strlen(vcollision)+
				       strlen(SymbolTable->data[vname])));
	  if (vcollision == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  vcollision=strcat (vcollision, SymbolTable->data[vname]);
	  errors = TRUE;
	}
    }
  }

  return (! errors);
}

PUBLIC int
cprocs  (procs)
	INTlist	procs;
{
  INTlist  plist;
  INTlist  aux;
  int      proc;
  int      pname;
  int      errors;
  char*    sep = ", ";

  errors = FALSE;
  pcollision = (char*) malloc (2);
  if (pcollision == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  pcollision = strcpy (pcollision, " ");
  for (plist= procs; plist != NULL; plist = INTtail (plist)){
    if ((proc = INThead (plist)) > 0){
      pname = (int)ATable->data[proc].value1;
      for (aux = INTtail(plist); aux != NULL; aux = INTtail (aux))
	if ((pname == (int)ATable->data[INThead(aux)].value1)){
	  if (strlen(pcollision) != 1){
	    pcollision = realloc (pcollision, (unsigned)(2+strlen (pcollision)));
	    if (pcollision == NULL){
	      (void)fprintf(stderr,"lsa: not enough memory\n");
	      exit(1);
	    }
	    pcollision = strcat (pcollision, sep);
	  }
	  pcollision=realloc(pcollision,
			    (unsigned)(strlen(pcollision)+
				       strlen(SymbolTable->data[pname])));
	  if (pcollision == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  pcollision=strcat (pcollision, SymbolTable->data[pname]);
	  errors = TRUE;
	}
    }
  }

  return (! errors);
}


PUBLIC int
cgates  (gates)
	INTlist	gates;
{
  INTlist  glist;
  INTlist  aux;
  int      gate;
  int      gname;
  int      errors;
  char*    sep = ", ";

  errors = FALSE;
  gcollision = (char*) malloc (2);
  if (gcollision == NULL){
    (void)fprintf(stderr,"lsa: not enough memory\n");
    exit(1);
  }
  gcollision = strcpy (gcollision, " ");
  for (glist= gates; glist != NULL; glist = INTtail (glist)){
    if ((gate = INThead (glist)) > 0){
      gname = (int)ATable->data[gate].value1;
      for (aux = INTtail(glist); aux != NULL; aux = INTtail (aux))
	if ((gname == (int)ATable->data[INThead(aux)].value1)){
	  if (strlen(gcollision) != 1){
	    gcollision = realloc (gcollision, (unsigned)(2+strlen (gcollision)));
	    if (gcollision == NULL){
	      (void)fprintf(stderr,"lsa: not enough memory\n");
	      exit(1);
	    }
	    gcollision = strcat (gcollision, sep);
	  }
	  gcollision=realloc(gcollision,
			    (unsigned)(strlen(gcollision)+
				       strlen(SymbolTable->data[gname])));
	  if (gcollision == NULL){
	    (void)fprintf(stderr,"lsa: not enough memory\n");
	    exit(1);
	  }
	  gcollision=strcat (gcollision, SymbolTable->data[gname]);
	  errors = TRUE;
	}
    }
  }

  return (! errors);
}

PUBLIC int
ngts (puid)
	int puid;
{
  if (puid <= 0)
    return 0;
  else
    return INTlength ((INTlist)ATfind (ATable, puid, c_gates)->value);
}

PUBLIC INTlist
gfs	(puid)
	int puid;
{
  if (puid <= 0)
    return 0;
  else
    return (INTlist)ATfind (ATable, puid, c_vals)->value;
}

/* imports a type from the library file */
PUBLIC int
timp (lexv, llib, node)
	int	lexv;
	TNODE*	llib;
	TNODE*	node;
{
  TNODE* type;
  TNexp* exp;
  int    nuid;

  if (lib == NULL){
    report (node, c_line);
    (void) fprintf (stderr,"lsa: missing library name\n\n");
    exit (1);
  }
  exp = NULL;
  for (type = gt_fs(llib); type != NULL; type = gt_rb (type))
    if (SymbolTable->data[(int) find_attr (c_lexv, gt_fs(type))->value]
	== SymbolTable->data[lexv]){
      exp = (TNexp*) find_attr (c_exp, type)->value;
      break;
    }

  if (exp == NULL){
    report (node, c_line);
    (void) fprintf(stderr,
		   "lsa: type \"%s\" not found at library\n",
		   SymbolTable->data[lexv]);
    exit (1);
  } else {
    if (exp->exp->make == FALSE)
      impexp (exp, llib);
  }
  nuid = (int)find_attr (c_iddec, gt_fs(type)) ->value;

  return nuid;
}

PUBLIC TNODE*
mktype (fexp, canon, type)
	TNexp*	fexp;
	int     canon;
	TNODE*  type;
{
  TNODE* ntype;
  TNODE* new;
  TNODE* tunion=NULL;
  Texpr* exp;
  TNexp* auxnexp;
  TNexp* newnx;
  TNexp* nexp=NULL;
  Texpr* auxexpr=NULL;

  for ( auxnexp = fexp; auxnexp != NULL; auxnexp = auxnexp->next){
    exp = auxnexp->exp;
    if (! included (nexp, auxnexp)){
      newnx = newnexp();
      auxexpr= newexpr ();
      newnx->exp= auxexpr;

      auxexpr->make     = exp->make;
      auxexpr->type     = exp->type;
      auxexpr->complete = exp->complete;
      auxexpr->sorts    = exp->sorts;
      auxexpr->opns     = exp->opns;
      auxexpr->eqns     = exp->eqns;
      auxexpr->fsorts   = exp->fsorts;
      auxexpr->fopns    = exp->fopns;
      auxexpr->feqns    = exp->feqns;
      auxexpr->gs       = exp->gs;
      auxexpr->go       = exp->go;

      newnx->next = nexp;
      nexp = newnx;
    }
  }

  assert (type != NULL);
  for (auxnexp= nexp; auxnexp!=NULL; auxnexp=auxnexp->next){
    auxexpr= auxnexp->exp;
    if (auxexpr->complete==FALSE)
      gtotype (auxnexp->exp);
  }

  if (gt_fs (gt_rb(gt_fs(type)))->type == ttype_identifier){
  /* renaming or actualization type */
    ntype = cp_node (type,TRUE);
    ntype->father= NULL;
    ntype->brothers= NULL;
    (void)lnsons (ntype,cp_node (type->sons,TRUE));
    (void)lnsons (ntype, cp_node (fexp->exp->type->sons->brothers,TRUE));
    if (fexp->exp->type->sons->brothers->sons->type == ttype_union)
      (void)lnsons(ntype->sons->brothers,
	     cp_node(fexp->exp->type->sons->brothers->sons->brothers,TRUE));
    else
      (void)lnsons(ntype->sons->brothers,
	     cp_node(fexp->exp->type->sons->brothers->sons,TRUE));

    ntype->sons->brothers->sons->sons= NULL;
  } else {
    /* union */
    ntype = cp_node (type,TRUE);
    ntype->father= NULL;
    ntype->brothers= NULL;
    (void)lnsons (ntype,cp_node (type->sons,TRUE));
    (void)lnsons (ntype, cp_node (type->sons->brothers,TRUE));
    if (type->sons->brothers->sons->type == ttype_union)
      (void)lnsons(ntype->sons->brothers,
	     cp_node(type->sons->brothers->sons->brothers,TRUE));
    else
      (void)lnsons(ntype->sons->brothers,
	     cp_node(type->sons->brothers->sons,TRUE));
    ntype->sons->brothers->sons->sons= NULL;
  }

  for (auxnexp= nexp; auxnexp!=NULL; auxnexp=auxnexp->next){
    if((canon == TRUE)||
       (auxnexp->exp->complete==FALSE)||
       (type == auxnexp->exp->type))
      unir (ntype, auxnexp->exp, canon);
    else {
      if (tunion == NULL)
	tunion = new_node (ttype_union);
      new = new_node (ttype_identifier);
      new ->value0 = (CLR_TYPE) IATadd (grntype_identifier, grnl, TRUE);
      new->father = tunion;
      new->brothers = tunion->sons;
      add_attr (c_idref, new)->value =
	      (CLR_TYPE) find_attr (c_iddec,auxnexp->exp->type->sons)->value;
      add_attr (c_line, new)->value =
	      (CLR_TYPE) find_attr (c_line, ntype->sons)->value;
      tunion->sons  = new;
    }
  }
  if (tunion != NULL){
    (void)lnnson (ntype->sons->brothers, tunion, 1);
    ntype->sons->brothers->sons->value0=
		(CLR_TYPE)IATadd(grntype_union,grnl,TRUE);
    ntype->sons->brothers->sons->value1=(CLR_TYPE)1;
  }

  newclase (ntype);

  return ntype;
}
PUBLIC int
buscar (r)
   TNODE* r;
{
  r = lksucc (r, tprocess_definition, PREORDER);
  return 0;
}

PUBLIC INTlist
gsorts (opnlist)
	INTlist opnlist;
{
  INTlist	sortlist = NULL;

  for (; opnlist!= NULL; opnlist = INTtail (opnlist))
    if (INThead(opnlist)> 0)
      sortlist = INTcons ((int)ATfind (ATable, INThead(opnlist),c_sort)->value,
			  sortlist);
    else
      sortlist = INTcons (UNDEF, sortlist);

  return INTrev (sortlist);
}

PUBLIC int
isformal (type)
	TNODE*	type;
{
  TNODE* tpexp;
  int	 tid;
  TATTR* attrisf;
  int    isf;



  if (type->type == ttype_identifier){
    tid= (int)fdclr(c_idref,type,1000+__LINE__);
    if (tid < 0)
      return TRUE;

    return isformal ((TNODE*)ATfind(ATable, tid,c_addr)->value);
  } else {
    tid= (int)fdclr(c_iddec,gt_fs(type),1000+__LINE__);
    if (tid < 0)
      return TRUE;

    attrisf = find_attr(c_formal,type);

    if (attrisf == NULL)
      set_attr(c_formal, type, (CLR_TYPE) WORKING);
    else {
      isf= (int)attrisf->value;
      if (isf == ISFORMAL) return TRUE;
      if (isf == NOFORMAL) return FALSE;
      if (isf == WORKING)  return TRUE;
      find_attr(c_formal, type)->value = (CLR_TYPE) WORKING;
    }
    tpexp = gt_rb(gt_fs(type));
    if (gt_fs (tpexp)->type != ttype_identifier)
      isf = isfun (type);
    else {
      if (gt_rb(gt_fs (tpexp))->type == treplacement)
	isf = isfren (type);
      else
	isf = isfact (type);
    }
  }
  if (isf == TRUE)
    find_attr (c_formal, type)->value= (CLR_TYPE)ISFORMAL;
  else
    find_attr (c_formal, type)->value= (CLR_TYPE)NOFORMAL;
  return isf;
}


PUBLIC INTlist
pilist (L1, L2)
	INTlist L1;
	INTlist L2;
{
  INTlist  auxl;
  int      val,i;

  if (tproc < ATable->size+1){
    if (tproc == 0)
      procesed=(int*)malloc((unsigned)((BUCKSIZE+ATable->size)*(sizeof(int))));
    else
      procesed=(int*)realloc((char*)procesed,
			   (unsigned)((BUCKSIZE+ATable->size)*(sizeof(int))));
    if (procesed == NULL){
      (void) fprintf (stderr,"lsa: not enough memory\n");
       exit (1);
    }

    tproc = ATable->size+BUCKSIZE;
  }
  for  (i= 1; i<=ATable->size; i++)
    procesed[i] = 0;

  for(auxl=L1;auxl!=NULL; auxl=INTtail(auxl))
    procesed[INThead(auxl)]=1;

  for (; L2 != NULL; L2 = INTtail (L2)){
    val = INThead(L2);
    if (procesed[val]==0){
      L1 = INTcons (val, L1);
      procesed[val]=1;
    }
  }
  return L1;
}

PUBLIC int
compact (root)
	TNODE* root;
{
  int msort, mopns;
  int *sort, *opns;
  TATTR* auxattr;
  TNODE* aux;
  int    uid, ui;
  int    luis, luio;
  int    i,j;

  msort= (int) find_attr (c_so, root)->value;
  mopns= (int) find_attr (c_op, root)->value;

  sort =(int*)malloc((unsigned)(msort+1)*(sizeof(int)));
  opns =(int*)malloc((unsigned)(mopns+1)*(sizeof(int)));

  for (i = 0; i<= msort; i++){
    sort[i] = 0;
  }
  for (i = 0; i<= mopns; i++){
    opns[i] = 0;
  }

  for (aux = root; aux != NULL; aux = succ (aux, PREORDER)){
     switch (aux->type){
	case tsort_identifier:
	      if ((auxattr = find_attr (c_iddec, aux))== NULL)
		if ((auxattr = find_attr (c_idref, aux))== NULL){
		  report (aux, c_line);
		  (void) fprintf (stderr, "lsa: not found unique identifier");
		  return FALSE;
		}
	      uid = (int) auxattr -> value;
	      assert((int)ATable->data[uid].value0 == TSORT);
	      ui = (int) ATfind (ATable, uid, c_ui)->value;
	      sort[ui] = 1;
	      break;
	case toperation_identifier:
	      if ((auxattr = find_attr (c_iddec, aux))== NULL)
		if ((auxattr = find_attr (c_idref, aux))== NULL){
		  report (aux, c_line);
		  (void) fprintf (stderr, "lsa: not found unique identifier");
		  return FALSE;
		}
	      uid = (int) auxattr -> value;
	      assert((int)ATable->data[uid].value0 == TOPN);
	      ui = (int) ATfind (ATable, uid, c_ui)->value;
	      opns[ui] = 1;
	      break;
     }
  }
  for (i=1,j=1; i<= msort; i++){
    if (sort[i] != 0)
      sort[i] = j++;
  }
  set_attr (c_cso, root, (CLR_TYPE)j);
  for (i=1,j=1; i<= mopns; i++){
    if (opns[i] != 0)
      opns[i] = j++;
  }
  set_attr (c_cop, root, (CLR_TYPE)j);
  for (i=1; i< ATable->size; i++){
    switch ((int)ATable->data[i].value0){
      case TSORT:
	    ui = (int) ATfind (ATable, i, c_ui)->value;
	    if (sort[ui] != 0)
	      ATset (ATable, i, c_cui, (CLR_TYPE)sort[ui]);
	    break;
      case TOPN :
	    ui = (int) ATfind (ATable, i, c_ui)->value;
	    if (opns[ui] != 0)
	      ATset (ATable, i, c_cui, (CLR_TYPE)opns[ui]);
	    break;
    }
  }

  return TRUE;
}

PUBLIC void
fataler (str)
  char* str;
{
  (void) fprintf(stderr,"\nlsa fatal error:\n");
  (void) fprintf(stderr,"\t%s\n\n", str);
}
