/******************************************************
 *      ldi.c:	Semantic analyzer of LOTOS Data Interpreter (LDI)
 ******************************************************/
/***********************************
   (C) Copyright 1992-1993; dit/upm
   Distributed under the conditions stated in the
   TOPO General Public License (see file LICENSE)
 ***********************************
 $Log: ldi.c,v $
 * Revision 1.2  1994/07/19  12:34:45  lotos
 * revised naming of files
 *
 * Revision 1.1  1994/07/18  18:34:49  lotos
 * Initial revision
 *
 * Revision 2.3  1993/09/20  12:39:05  lotos
 * synchronized with kaos development
 * adpated to kdatum
 * udatum are not expected to be used
 * reduce number of reserved words: new user lexicon
 *
 * Revision 2.2  1993/06/22  08:49:38  lotos
 * fix variable redeclaration
 * fix standard input reading (batch mode)
 *
 * Revision 2.1  1993/06/10  13:37:30  lotos
 * completely remade
 *
 * Revision 1.4  1993/01/18  18:26:47  lotos
 * distribution issues
 *
 * Revision 1.3  1993/01/12  20:21:35  lotos
 * portability issues
 *
 * Revision 1.2  1992/11/19  18:42:55  lotos
 * fix naming conventions
 * initial load of specification
 * bug fixing --w.r.t. reading idle comments
 *
 * Revision 1.1  1992/11/17  18:27:05  lotos
 * Initial revision
 *
 ***********************************/

#ifndef lint
static char rcsid[]= "$Id: ldi.c,v 1.2 1994/07/19 12:34:45 lotos Exp $";
#endif

#define ldi_IMP

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <assert.h>

#include "dtok.hh"
#include "alga.hh"
#include "ldi.hh"

#define DEBU 0
#define NSMAX 10
#define NOMAX 10
#define CON 1
#define VAL 2
#define RES 3
#define OPNM 1
#define VALM 2
#define OPNL 1
#define SORL 2
#define EQN_SIZE 20

/* KJT 20/01/23: added function prototypes */
PUBLIC int _xd_kd2sort(kdatum dat);
PUBLIC klink _xd_link ();
PUBLIC int _xd_opn (int sort, char *name);
PUBLIC int _xd_v_sort(char *snm);

/*******  variable declaration  *******/

static int first = 1;
int firstpat,redundant,semired;
int iindent = 0;
v_node    *explorer;
FILE *fw;
int eqn_number;

int trace =1;
int seqn =0;
int srw =0;
int sr =0;

unsigned   opn_tbl_size;       /* operation table size */
tOPN_TBL   opn_tbl;            /* table of operations */
i_tOPN_TBL i_opn_tbl;          /* internal table of operations */

tSORT_TBL  sort_tbl;           /* table of sorts */
unsigned   sort_tbl_size;      /* sort table size */

tEQN_TBL   eqn_tbl;            /* table of equation comments */
int        eqn_tsize;          /* size of eqn_tbl */

tVAR_TBL   var_tbl;            /* table of variables */
unsigned   var_tbl_size;       /* var table size */
unsigned   var_size;           /* size of vars */
int nor;                       /* number of rewritings */
int rdeb;                      /* comment tracing mode:
				       1 -> yes
				       0 -> no  */

/***** memory allocation functions *****/

#define tfree(ptr)      ((void) free(ALIN(char, ptr)))



void            gl_cleanup(/* void */); /* to undo gl_init */


/***** private functions *******/
/* it checks that v1 ins not in the vlist
   TRUE it is in vlist
   FALSe it is not in vlist */
PRIVATE int
chk_lnk (v1, vlist)
	int v1;
	int vlist;
{

  assert (-v1 <= var_tbl_size);
  assert (-vlist <= var_tbl_size);

  assert (var_tbl[-v1].use == NOT_FREE);
  assert (var_tbl[-vlist].use == NOT_FREE);

  if (v1 == vlist)
    return TRUE;
  else if (var_tbl[-vlist].lnk == 0){
    return FALSE;
  } else {
    return chk_lnk (v1, var_tbl[-vlist].lnk);
  }

}
PRIVATE void
usrbreak()
{
  (void) signal (SIGINT, usrbreak);
  usrb = TRUE;
  return;
}

/*
------------------------- FUNCTION INIT_STRUCT ----------------------

     PARAMETERS:
		- ptr: pointer to the structure.
		- tptr: type of the structure.

     DESCRIPTION:
		 - it initialize the structure variables to the
		   default values.

---------------------------------------------------------------------
*/
PRIVATE void
init_struct (ptr,tptr)

  void *ptr;
  int  tptr;

{
  v_node *vptr;
  c_node *cptr;

  switch (tptr){
/*******************************************************
  if the structure is a condition node
*******************************************************/
    case CON:
      cptr = (c_node *) ptr;
      cptr->narg = 0;
      cptr->argument = NULL;
      cptr->nvnode = NULL;
      break;
/*******************************************************
  if the structure is a value node
*******************************************************/
    case VAL:
      vptr = (v_node *) ptr;
      vptr->value = 0;
      vptr->eqn = -1;
      vptr->ncnode = NULL;
      vptr->nvnode = NULL;
      vptr->nrnode = NULL;
      vptr->npnode = NULL;
      break;
  }
}
/*
------------------------- FUNCTION INIT_LIST ------------------------

     PARAMETERS:
		- flimit: first limit of the list to initialize.
		- llimit: last limit of the list to initialize.
		- tlist: type of the list to initialize.

     DESCRIPTION:
		 - it initialize a list to the default values.

---------------------------------------------------------------------
*/
PRIVATE void
init_list (flimit,llimit,tlist)

  unsigned flimit,llimit,tlist;

{
/*******************************************************
  if the list is of operations
*******************************************************/
    if (tlist == OPNL)
    for (;flimit<=llimit;flimit++){
      opn_tbl[flimit].oid = 0;
      opn_tbl[flimit].sid = 0;
      opn_tbl[flimit].narg = 0;
      opn_tbl[flimit].sarg = NULL;
      opn_tbl[flimit].isextern = FALSE;
      opn_tbl[flimit].isinfix = FALSE;
      opn_tbl[flimit].name = NULL;
      i_opn_tbl[flimit].cnode = NULL;
      i_opn_tbl[flimit].rnode = NULL;
      i_opn_tbl[flimit].fnode = NULL;
    }
/*******************************************************
  if the list is of sorts
*******************************************************/
    else
    for (;flimit<=llimit;flimit++){
      sort_tbl[flimit].sid = 0;
      sort_tbl[flimit].isextern = FALSE;
      sort_tbl[flimit].name = NULL;
    }
}
/*
------------------------- FUNCTION ADD_SORT -------------------------

     PARAMETERS:
		- recp: record with the information to store.
		- nsort: number of the highest sort stored.

     DESCRIPTION:
		 - it adds the sort information to the sort table
		   (sort_tbl).

---------------------------------------------------------------------
*/
PRIVATE void
add_sort  (recp,nsort)

  sREC *recp;
  unsigned nsort;
{
  unsigned num;
/*******************************************************
  It gets the absolute value of the sort
*******************************************************/
  num = abs (field (recp,3,INT));
/*******************************************************
  if there is not enough memory, It reallocates it
  and initialize the new list.
*******************************************************/
  if (num>NSMAX && num>nsort) {
    if (nsort<NSMAX)
      nsort = NSMAX;
    trealloc (sort_tbl,num+1);
    init_list (nsort+1,num,SORL);
  }
/*******************************************************
  It assigns the new values
*******************************************************/
  sort_tbl[num].sid = field (recp,2,SYM);
  talloc(sort_tbl[num].name,strlen(sym_name(field(recp,4,SYM))));
  sort_tbl[num].name = sym_name (field (recp,4,SYM));

}
/*
------------------------- FUNCTION ADD_OPER -------------------------

     PARAMETERS:
		- recp: record with the information to store.
		- noper: number of the highest operation stored.

     DESCRIPTION:
		 - it adds the operation information to the operation
		   table (opn_tbl).

---------------------------------------------------------------------
*/
PRIVATE void
add_oper  (recp,noper)

  sREC *recp;
  unsigned noper;
{
  unsigned num,iarg;
/*******************************************************
  it gets the absolute value of the operation
*******************************************************/
  num = abs (field (recp,3,INT));
/*******************************************************
  if there is not enough memory, It reallocates it
  and initialize the new list.
*******************************************************/
  if (num>NOMAX&& num>noper) {
    if (num<NOMAX)
      noper=NOMAX;
    trealloc (opn_tbl,num+1);
    trealloc (i_opn_tbl,num+1);
    init_list (noper+1,num,OPNL);
  }
/*******************************************************
  if there is a duplicated operation identifier
  display a message and exits.
*******************************************************/
  for (iarg=1;iarg<=noper;iarg++)
    if (opn_tbl[iarg].oid == field (recp,2,SYM)){
      (void) printf ("Error: duplicated operation identifier. \n");
      exit(1);
    }
/*******************************************************
  it assigns the new values
*******************************************************/
  opn_tbl[num].oid = field (recp,2,SYM);
  opn_tbl[num].sid = abs (field (recp,6,INT));
  opn_tbl[num].narg = field (recp,7,INT);
  talloc (opn_tbl[num].sarg,field(recp,7,INT)+1);
  for (iarg=0;iarg<opn_tbl[num].narg;iarg++)
    opn_tbl[num].sarg[iarg] = abs(field(recp,8+iarg,INT));
  if (nofld(recp) < 8 + iarg)
    opn_tbl[num].isinfix= FALSE;
  else {
    abort_if(field(recp, 8 + iarg, SYM) != ANNOTATION &&
	     field(recp, 9 + iarg, SYM) != INFIX_ANNOTATION)
    opn_tbl[num].isinfix= TRUE;
  }
  talloc(opn_tbl[num].name,strlen(sym_name(field(recp,4,SYM))));
  opn_tbl[num].name = sym_name (field (recp,4,SYM));
}

/*
------------------------- FUNCTION FILL_COND ------------------------

     PARAMETERS:
		- condptr: pointer to the condition (c_node).
		- recp: record with the information to store.
		- tmatch: type of matching. It can be:
		   * value: any operation.
		   * operation: a concrete operation.

     DESCRIPTION:
		 - it fills the condition node of the current operation
		   with the arguments (converted to an integer array)
		   to be evaluated for applying the rule.

---------------------------------------------------------------------
*/
PRIVATE void
fill_cond (condptr,recp,tmatch)

  sREC *recp;
  c_node *condptr;
  short tmatch;

{
  int index;
/*******************************************************
  it assigns the number of arguments of the condition
  to the variable.
*******************************************************/
  if (tmatch == VALM)
    condptr->narg = nofld (recp) -1;
  else
    condptr->narg = nofld (recp) - 2;
  if (fldty(recp, nofld(recp) - 1) == SYM &&
      field(recp, nofld(recp) - 1, SYM) == COMMENT)
    condptr->narg-= 2;
/*******************************************************
  it assigns the value of the arguments to the variables.
*******************************************************/
  if (condptr->narg!=0)
    talloc (condptr->argument,condptr->narg+1);
  for (index=1;index<=condptr->narg;index++){
    if (tmatch == OPNM)
      condptr->argument[index] = abs (field (recp,index+2,INT));
    else
      condptr->argument[index] = abs (field (recp,index+1,INT));
  }
}
/*
------------------------- FUNCTION DRAW_PRECON -----------------------

     PARAMETERS:
		- index: pointer to the structure to draw.
		- ispre: indicates if the structure is precondition
			 (1) or replacement (0).

     DESCRIPTION:
		 - it writes in a specified file the precondition or
		   replacement tree. It will be used normally in
		   the debugging phase.

---------------------------------------------------------------------
*/
PRIVATE void
draw_precon (index,ispre)

  klink index;
  int ispre;
{
  int counter;
  a_list *aaux;

  while (index!=NULL){
/*******************************************************
  it indents the file, firstly.
*******************************************************/
    for (counter=1;counter<=iindent;counter++,(void) fprintf(fw," "));
/*******************************************************
  it writes the correct letter: P (precondition)
				R (replacement)
*******************************************************/
    if (ispre)
      (void) fprintf (fw,"P: ");
    else
      (void) fprintf (fw,"R: ");
/*******************************************************
  it writes the operation. It may be: equal,push
  or another one.
*******************************************************/
    if (index->arg->opn==-1)
      (void) fprintf (fw,"EQUAL \n");
    else if (index->arg->opn==-2){
      (void) fprintf (fw,"PUSH ");
      aaux=(struct A_list *)index->arg->lnk;
      while (aaux!=NULL){
	(void) fprintf (fw,"%d ",aaux->argument);
	aaux=aaux->next;
      }
      (void) fprintf (fw,"\n");
    }
    else
      (void) fprintf (fw,"%d \n",index->arg->opn);
    iindent=iindent+1;
/*******************************************************
  if there are sons the function call itself recursivitily
*******************************************************/
    if (index->arg->opn!=-2)
      draw_precon (index->arg->lnk,ispre);
    iindent=iindent-1;
    index = index->next;
  }
}
/*
------------------------- FUNCTION DRAW_CONDITION -------------------

     PARAMETERS:
		- index: pointer to the structure to draw.

     DESCRIPTION:
		 - it writes in a specified file the condition tree.
		   It will be used normally in the debugging phase.

---------------------------------------------------------------------
*/
PRIVATE void
draw_condition (index)

  c_node *index;
{
  v_node *aux;
  int counter,inarg;
  klink saux;

  if (index != NULL) {
    aux = index->nvnode;
/*******************************************************
  firstly, it indents the file
*******************************************************/
    while (aux!=NULL){
      for (counter=1;counter<=iindent;counter++,(void) fprintf(fw," "));
      (void) fprintf (fw,"C:");
      if (!index->narg)
	(void) fprintf (fw,"0");
/*******************************************************
  it writes the arguments of the condition set
*******************************************************/
      for (inarg=1;inarg<=index->narg;inarg++)
	(void) fprintf (fw," %d",index->argument[inarg]);
      (void) fprintf (fw," V: %d \n",aux->value);
/*******************************************************
  it writes the necessary value to satisfy the condition
*******************************************************/
      iindent=iindent+2;
      draw_condition (aux->ncnode);
      saux=aux->npnode;
      while (saux != NULL){
	draw_precon (saux,1);
	saux=saux->next;
      }
      draw_precon (aux->nrnode,0);
      iindent=iindent-2;
      aux = aux->nvnode;
    }
  }
}
/*
------------------------- FUNCTION DRAW_TREE ------------------------

     PARAMETERS:
		- nsort: highest sort number.
		- noper: highest operation number.

     DESCRIPTION:
		 - it writes in a specified file the general tree
		   containing sorts, operations, conditions,
		   preconditions and replacements.
		   It will be used normally in the debugging phase.

---------------------------------------------------------------------
*/
PRIVATE void
draw_tree (nsort,noper)
  unsigned nsort,noper;
{
  int index,iarg;
/*******************************************************
  it writes the sort list
*******************************************************/
  for (index=1;index <= nsort;++index){
    (void) fprintf (fw,"SORT NUMBER %d ",index);
    (void) fprintf (fw,"id: %d",sort_tbl[index].sid);
    (void) fprintf (fw,"  number: %d ",index);
    (void) fprintf (fw,"  name: %s \n",sort_tbl[index].name);
  }
/*******************************************************
  it writes the operation list
*******************************************************/
  for (index=1;index <= noper;++index){
    (void) fprintf (fw,"OPERATION NUMBER %d ",index);
    (void) fprintf (fw,"id: %d ",opn_tbl[index].oid);
    (void) fprintf (fw,"tipo: %d ",opn_tbl[index].sid);
    (void) fprintf (fw,"number: %d ",index);
    (void) fprintf (fw,"narg: %d ",opn_tbl[index].narg);
    for (iarg=0;iarg<opn_tbl[index].narg;iarg++)
      (void) fprintf (fw,"targ: %d ",opn_tbl[index].sarg[iarg]);
    (void) fprintf (fw,"name: %s \n",opn_tbl[index].name);
    draw_condition (i_opn_tbl[index].cnode);
  }
}
/*
------------------------- FUNCTION ADD_PATTERN ----------------------

     PARAMETERS:
		- recp: record with the information to store.
		- currop: number of the current operation.
		- tmatch: type of matching. It can be:
		   * value
		   * operation

     DESCRIPTION:
		 - it adds the pattern information to the current
		   operation.

---------------------------------------------------------------------
*/

PRIVATE void
add_pattern (recp,currop,tmatch)

  sREC *recp;
  unsigned currop;
  short tmatch;

{
/*******************************************************
  if the pattern is redundant, it goes to the right
  position, skipping the redundant operations
*******************************************************/
  if (redundant){
    explorer = explorer->ncnode->nvnode;
    while (explorer->nvnode!=NULL)
      explorer = explorer->nvnode;
    redundant--;
  }
/*******************************************************
  if it is the first pattern, there is not similitude
  with anyone
*******************************************************/
  else if (firstpat){
    talloc (i_opn_tbl[currop].cnode,1);
    init_struct ((void *)i_opn_tbl[currop].cnode,CON);
    fill_cond (i_opn_tbl[currop].cnode,recp,tmatch);
    talloc (explorer,1);
    init_struct ((void *)explorer,VAL);
    if (tmatch == VALM)
      explorer->value = -1;
    else
      explorer->value = field (recp,2,INT);
    i_opn_tbl[currop].cnode->nvnode = explorer;
  }
/*******************************************************
  if it is semiredundant, the condition is the same
  that the one of the previous pattern; but the
  value is different
*******************************************************/
  else if (semired){
    semired = 0;
    while (explorer->nvnode!=NULL)
      explorer = explorer->nvnode;
    talloc (explorer->nvnode,1);
    explorer = explorer->nvnode;
    init_struct ((void *)explorer,VAL);
    if (tmatch == VALM)
      explorer->value = -1;
    else
      explorer->value = field (recp,2,INT);
  }
/*******************************************************
  in other case, all is different
*******************************************************/
  else{
    talloc (explorer->ncnode,1);
    init_struct ((void *)explorer->ncnode,CON);
    fill_cond (explorer->ncnode,recp,tmatch);
    talloc (explorer->ncnode->nvnode,1);
    explorer = (explorer->ncnode)->nvnode;
    init_struct ((void *)explorer,VAL);
    if (tmatch == VALM)
      explorer->value = -1;
    else
      explorer->value = field (recp,2,INT);
  }
}
/*
------------------------- FUNCTION ADD_PRECON -----------------------

     PARAMETERS:
		- saux: pointer to the node to hang the information.
		- noper: number of the highest operation number.

     DESCRIPTION:
		 - it adds the precondition or replacement information
		   to the current operation.

---------------------------------------------------------------------
*/
/* funcion de annadir precondicion.

    opn -1 => operacion EQUAL;
    opn -2 => operacion PUSH;
*/

PRIVATE void
add_precon (saux,noper)

  klink saux;
  unsigned noper;
{
  sREC *recp;
  a_list *aaux;
  int npar,index;
  int debug;

  recp = get_rec();
  switch (field(recp,1,SYM)){
/*******************************************************
  if it is an operation evaluation it creates a node
     - equal node => opn=-1
     - operation node => opn=opn (read in the file)
*******************************************************/
    case OPERATION_EVAL:
      if (field(recp,2,SYM)==EQUAL){
	saux->arg=kd_alloc();
	saux->arg->opn=-1;
	npar = 2;
      }
      else{
	saux->arg=kd_alloc();
	for (index= 1;
	     index <= noper && opn_tbl[index].oid != field (recp, 2, SYM);
	     index++)
	  ;
	if (opn_tbl[index].oid != field (recp, 2, SYM)) {
	  (void) fprintf (stderr,"Input file error: \n");
	  (void) fprintf (stderr,"Undefined ==> %s\n",sym_name(field(recp,2,SYM)));
	  exit(1);
	}
	saux->arg->opn=index;
	debug = kaos.debug; /* It avoids error checking when building expressions */
	kaos.debug = FALSE;
	saux->arg = kd_copy (saux->arg);
	kaos.debug = debug;
	npar=field(recp,3,INT);
      }
      break;
/*******************************************************
  if it is a value evalation it creates a variable node
					    ( opn=-2)
*******************************************************/
    case VALUE_EVAL:
      saux->arg=kd_alloc();
      saux->arg->opn=-2;
      talloc (aaux,1);
      aaux->argument=field(recp,2,INT);
      aaux->next=NULL;
      saux->arg->lnk=(struct Klink *)aaux;
      index= nofld(recp) - 2;
      if (fldty(recp, nofld(recp) - 1) == SYM &&
	  field(recp, nofld(recp) - 1, SYM) == COMMENT)
	index-= 2;
      for (npar=3;index>0;index--,npar++){
	talloc (aaux->next,1);
	aaux->next->argument=field(recp,npar,INT);
	aaux->next->next=NULL;
	aaux=aaux->next;
      }
      npar=0;
      break;
    case COMMENT:
    case ANNOTATION:
      add_precon (saux,noper);
      return;
    default:
      recp = get_rec();
      npar=0;
      break;
  }
  index=1;
/*******************************************************
  if there are sons, all the klink are created
*******************************************************/
  while (npar){
    if (index){
      saux->arg->lnk=kd_link();
      saux=saux->arg->lnk;
      index=0;
    }
    else{
      saux->next=kd_link();
      saux=saux->next;
    }
    add_precon(saux,noper);
    npar--;
  }
}
/*
------------------------- FUNCTION MK_TEQN --------------------------

     PARAMETERS:
		- recp: record with the information to store.

     DESCRIPTION:
		 - it creates a table with the comments of the
		   equations of the specification file.

---------------------------------------------------------------------
*/

PRIVATE void
mk_teqn (recp)

  sREC *recp;
{
  int len = 0;
  int len2;
  int isfirst = 1;
  char *p;

/*******************************************************
  it allocates the necessary memory
*******************************************************/
  eqn_number = field (recp,3,INT);
  if (eqn_number>=eqn_tsize){
    if (eqn_tsize==0){
      if (eqn_number >= EQN_SIZE)
	eqn_tsize = eqn_number+1;
      else
	eqn_tsize = EQN_SIZE;
      talloc (eqn_tbl,eqn_tsize);
      for (len2=0;len2<eqn_tsize;len2++){
	eqn_tbl[len2].counter = 0;
	eqn_tbl[len2].eqnstr = NULL;
      }
    }
    else{
      trealloc (eqn_tbl,eqn_number+1);
      for (len2=eqn_tsize;len2<=eqn_number;len2++){
	eqn_tbl[len2].counter = 0;
	eqn_tbl[len2].eqnstr = NULL;
      }
      eqn_tsize = eqn_number+1;
    }
  }
/*******************************************************
  it stores the comments with the equation in the table
*******************************************************/
  while (field(recp,1,SYM)!=END_ANNOTATION){
    if (field(recp,1,SYM)==LINE_QUOTE){
      len2 = strlen (field(recp,2,STR)) + 1;
      len += len2;
      if (isfirst){
	talloc (eqn_tbl[eqn_number].eqnstr,len);
	isfirst = 0;
	p = eqn_tbl[eqn_number].eqnstr;
      }
      else{
	trealloc (eqn_tbl[eqn_number].eqnstr,len);
	eqn_tbl[eqn_number].eqnstr[len-len2-1]='\n';
	p = eqn_tbl[eqn_number].eqnstr+len-len2;
      }
      (void) strcpy (p,field(recp,2,STR));
      eqn_tbl[eqn_number].eqnstr[len-1]='\0';
    }
    recp = get_rec ();
  }
}

PRIVATE 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 */

/*
--------------------  LDIREPORT ------------------------------------

     PARAMETERS:
		 - msg: msg to report
     DESCRIPTION:
		 - It produces a report
---------------------------------------------------------------------
*/
PRIVATE void
ldireport (msg)
	char*   msg;
{
  (void) printf ("ldi: %s\n", msg);
}

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

/************** Table initialization *********/
/*
------------------------- FUNCTION LDI_INIT -----------------------

     PARAMETERS:
		- fich: name of the file to be read.

     DESCRIPTION:
		 - it reads a specified file and stores in memory the
		   information. It is an initializing function used
		   for interpreting a determinated specification.

---------------------------------------------------------------------
*/

PUBLIC int
ldi_init (fich)

  char *fich;
{
  sREC *rec;
  unsigned nsort = 0;
  unsigned noper = 0;
  unsigned currop = 0;
  int firstcond,isopn,iscond,cont;
  klink saux;
  FILE *fp,*freopen();
  char *fichero;

  ign_empty_rec = TRUE;
/*******************************************************
  it opens the file to be read
*******************************************************/

  talloc (fichero,strlen(fich)+6);
  (void) strcpy (fichero,fich);
  (void)strcat (fichero,".ldi");
  if ((fp = fopen (fichero,"r"))==NULL){
    (void) fprintf (stderr,"Error: ldi_init cannot open '%s'.\n",fichero);
    return 3;
  }
  (void) new_file (fp);
#if DEBU
    talloc (fichw,strlen(fich)+6);
    (void) strcpy (fichw,fich);
    (void)strcat (fichw,".resu");
#endif

/*******************************************************
  if there were more calls, it set the used memory free
*******************************************************/
  if (!first){
    tfree(sort_tbl);
    tfree(opn_tbl);
    tfree(i_opn_tbl);
    tfree (eqn_tbl);
  }
/*******************************************************
  it calls the initializing functions
*******************************************************/
  eqn_tsize = 0;
  eqn_number = 0;
  ldcinit();
  first=0;
  talloc (sort_tbl,NSMAX+1);
  init_list (0,NSMAX,SORL);
  talloc (opn_tbl,NOMAX+1);
  talloc (i_opn_tbl,NOMAX+1);
  init_list (0,NOMAX,OPNL);
/*******************************************************
  it reads records, while the file is not at the end
*******************************************************/
  while ((rec=get_rec()) != NULL) {
    switch (field(rec,1,SYM)) {
/*******************************************************
  it reads all the rule annotations
*******************************************************/
      case BEGIN_ANNOTATION:
	if (field(rec,2,SYM) == RULE_ANNOTATION)
	  mk_teqn (rec);
	else {
	  while (field(rec,1,SYM) != END_ANNOTATION)
	    rec = get_rec();
	}
	break;
/*******************************************************
  it reads all the sort decarations
*******************************************************/
      case BEGIN_SORTS_DECL:
	while (field(rec,1,SYM) != END_SORTS_DECL) {
	  rec = get_rec();
	  if (field(rec,1,SYM) == SORT_DECL){
	    add_sort (rec,nsort);
	    if (nsort < abs (field(rec,3,INT)))
	      nsort = abs (field(rec,3,INT));
	  }
	}
	break;

/*******************************************************
  it reads all the operation declarations
*******************************************************/
      case BEGIN_OPERATIONS_DECL:
	while (field(rec,1,SYM) != END_OPERATIONS_DECL) {
	  rec = get_rec();
	  if (field(rec,1,SYM)  == OPERATION_DECL){
	    add_oper (rec,noper);
	    if (noper < abs (field(rec,3,INT)))
	      noper = abs (field(rec,3,INT));
	  }
	}
	break;
/*******************************************************
  it reads all the operation definitions
*******************************************************/
      case BEGIN_OPERATION_DEF:
	for (currop=0;opn_tbl[currop].oid!=field(rec,2,SYM) && currop <= noper                         ;++currop) ;
/*******************************************************
  if the operation is not previously defined, it is
  an error
*******************************************************/
	if (opn_tbl[currop].oid!=field(rec,2,SYM)){
	  (void) fprintf (stderr,"Input file error.\n");
	  (void) fprintf (stderr,"Undefined ==> %s\n",sym_name(field(rec,2,SYM)));
	  return (2);
	}
/*******************************************************
  case the operation definition is of build type;
  it implies there is no rule
*******************************************************/
	if (field(rec,3,SYM)==BUILD){
	  while (field(rec,1,SYM) != END_OPERATION_DEF ){
	    if (field(rec, 1, SYM) == BUILD && nofld(rec) > 3){
	      abort_if(field(rec, 4, SYM) != ANNOTATION &&
		       field(rec, 5, SYM) != FAIL_ANNOTATION)
	      abort_if(i_opn_tbl[currop].fnode != NULL)
	      talloc(i_opn_tbl[currop].fnode, 1);
	      i_opn_tbl[currop].fnode->line= field(rec, 7, INT);
	      i_opn_tbl[currop].fnode->file= sym_name(field(rec, 8, SYM));
	    }
	    rec = get_rec();
	  }
	}
/*******************************************************
  case the operation definition is of rewrite or
  general type; it implies there are rules
*******************************************************/
	else {
	  firstpat = 1;
	  while (field(rec,1,SYM) != END_OPERATION_DEF ){
	    switch (field(rec,1,SYM)) {
/*******************************************************
  case the record is a rule
*******************************************************/
	      case BEGIN_RULE:
		eqn_number = field (rec,2,INT);
		rec = get_rec ();
		firstcond = 1;
/*******************************************************
  if it is not the first pattern the explorer pointer
  goes to the right position
*******************************************************/
		if (!firstpat){
		  explorer = i_opn_tbl[currop].cnode->nvnode;
		  while (explorer->nvnode!=NULL)
		    explorer = explorer->nvnode;
		}
		while (field(rec,1,SYM)!=END_RULE){
		  switch (field(rec,1,SYM)){
		    case BEGIN_PATTERN:
		      isopn = 0;
		      iscond = 0;
		      redundant = field (rec,2,INT);
		      semired = field (rec,3,INT);
/*******************************************************
  if the rule is redundant and is not semiredundant,
  the rule is cosidered as it is semiredundant.
  This is due to the fact that the rule is like
  the previous one but with another precondition
*******************************************************/
		      if (redundant && !semired){
			semired++;
			redundant--;
		      }
/*******************************************************
  it evaluates the operation and value matches
*******************************************************/
		      while (field(rec,1,SYM) != END_PATTERN){
			switch (field(rec,1,SYM)){
			  case OPERATION_MATCH:
			  add_pattern (rec,currop,OPNM);
			  firstpat = 0;
			  isopn = 1;
			  break;
			  case VALUE_MATCH:
			  add_pattern (rec,currop,VALM);
			  firstpat = 0;
			  isopn = 1;
			  break;
			  default:
			  break;
			}
			rec = get_rec();
		      }
/*******************************************************
  if there was not any operation or value matching
  it will be created a condition with 0 value
*******************************************************/
		      if (!isopn){
			if (i_opn_tbl[currop].cnode==NULL){
			  talloc (i_opn_tbl[currop].cnode,1);
			  init_struct ((void *)i_opn_tbl[currop].cnode,CON);
			  talloc (i_opn_tbl[currop].cnode->nvnode,1);
			  init_struct ((void *)i_opn_tbl[currop].cnode->nvnode                                        ,VAL);
			}
			else{
			  explorer = i_opn_tbl[currop].cnode->nvnode;
			  while (explorer->nvnode!=NULL)
			    explorer = explorer->nvnode;
			  talloc (explorer->nvnode,1);
			  init_struct ((void *)explorer->nvnode,VAL);
			}
		      }
		      break;
/*******************************************************
  case the record is a precondition
*******************************************************/
		    case BEGIN_CONDITION:
		      iscond = 1;
		      cont = 1;
		      explorer = i_opn_tbl[currop].cnode->nvnode;
		      while (cont){
			while (explorer->nvnode!=NULL)
			  explorer = explorer->nvnode;
			if (explorer->ncnode == NULL)
			  cont = 0;
			else
			  explorer = explorer->ncnode->nvnode;
		      }
		      if (firstcond){
			if (explorer->npnode == NULL){
			  explorer->npnode=kd_link();
			  saux=explorer->npnode;
			  firstcond = 0;
			}
			else{
			  saux=explorer->npnode;
			  while (saux->next != NULL)
			    saux=saux->next;
			  saux->next=kd_link();
			  saux=saux->next;
			  firstcond=0;
			}
		      }
		      else{
			saux=explorer->npnode;
			while (saux!=NULL)
			  saux=saux->next;
			saux->next=kd_link();
			saux=saux->next;
		      }
		      add_precon (saux,noper);
		      firstcond=1;
		      while (field(rec,1,SYM) != END_CONDITION){
			rec = get_rec();
		      }
		      break;
/*******************************************************
  case the record is a replacement
*******************************************************/
		    case BEGIN_REPLACEMENT:
		      if (!isopn && !iscond && !opn_tbl[currop].narg){
			tfree (i_opn_tbl[currop].cnode->nvnode);
			tfree (i_opn_tbl[currop].cnode);
			i_opn_tbl[currop].cnode = NULL;
			i_opn_tbl[currop].rnode = kd_link ();
			add_precon (i_opn_tbl[currop].rnode,noper);
		      }
		      else{
			cont = 1;
			explorer = i_opn_tbl[currop].cnode->nvnode;
			while (cont){
			  while (explorer->nvnode!=NULL)
			    explorer = explorer->nvnode;
			  if (explorer->ncnode == NULL)
			    cont = 0;
			  else
			    explorer = explorer->ncnode->nvnode;
			}
			explorer->nrnode=kd_link();
			add_precon (explorer->nrnode,noper);
			explorer->eqn = eqn_number;
		      }
		      while (field(rec,1,SYM) != END_REPLACEMENT){
			rec = get_rec();
		      }
		      break;
		    default:
		      rec = get_rec();
		      break;
		}
	      }
	      case BUILD:
		if (field(rec, 1, SYM) == BUILD && nofld(rec) > 3){
		  abort_if(field(rec, 4, SYM) != ANNOTATION &&
			   field(rec, 5, SYM) != FAIL_ANNOTATION)
		  abort_if(i_opn_tbl[currop].fnode != NULL)
		  talloc(i_opn_tbl[currop].fnode, 1);
		  i_opn_tbl[currop].fnode->line= field(rec, 7, INT);
		  i_opn_tbl[currop].fnode->file= sym_name(field(rec, 8, SYM));
		}
		rec = get_rec();
		break;
	      default:
		rec = get_rec();
		break;
	    }
	  }
	}
    }
  }
  (void)fclose (fp);
  /*free (fichero);*/
/*******************************************************
  it writes the debugging file with the name of the
  read file, ".resu"
*******************************************************/
#if DEBU
    fw = fopen (fichw,"w");
    if (fw==NULL){
      (void) fprintf (stderr,"ldi_init cannot open %s.",fichw);
      sort_tbl_size = nsort+1;
      opn_tbl_size = noper+1;
      return 1;
    }
    else{
      draw_tree (nsort,noper);
      (void)fclose (fw);
    }
#endif
  sort_tbl_size = nsort+1;
  opn_tbl_size = noper+1;
  return 0;
}

/************** Symbolic interface *********/
PUBLIC int
getvsort (vid)
	int	vid;
{
  return var_tbl[-vid].sid;
}

PUBLIC char*
getvname (vid)
	int	vid;
{
  return var_tbl[-vid].name;
}

PUBLIC int
getopsort (opid)
	int	opid;
{
  return opn_tbl[opid].sid;
}

PUBLIC int
getkdsort (dat)
  kdatum dat;
{
  return _xd_kd2sort (dat);
}

PUBLIC int*
getopargs (opid)
	int	opid;
{
  return opn_tbl[opid].sarg;
}

PUBLIC char*
getsname (sid)
	int	sid;
{
  return sort_tbl[sid].name;
}

PUBLIC char*
getopname (opid)
	int	opid;
{
  return opn_tbl[opid].name;
}

PUBLIC int
getopnar (opid)
	int	opid;
{
  return opn_tbl[opid].narg;
}

PUBLIC int
getop_sarg (opid, arg)
	int	opid;
	int	arg;
{
  return opn_tbl[opid].sarg[arg];
}

PUBLIC int
isinfix (opid)
	int	opid;
{
 return opn_tbl[opid].isinfix;
}
/************** Functional Interface *********/
PUBLIC int
ldiequal (v1, v2)
	kdatum v1;
	kdatum v2;
{
  int s1,s2;

  if (v1->opn >0)
    s1 = opn_tbl[v1->opn].sid;
  else
    s1 = var_tbl[-(v1->opn)].sid;

  if (v2->opn >0)
    s2 = opn_tbl[v2->opn].sid;
  else
    s2 = var_tbl[-(v2->opn)].sid;

  if (s1 != s2){
    (void) fprintf (stderr, "equal: expression must be of the same sort\n");
    return FALSE;
  }
  return kd_equal (kd_rw_node(v1), kd_rw_node(v2));
}


/*
-----------------   FUNCTION GET_VAR_ID ------------------------------

    PARAMETERS:
		- name: name of the variable to search.
		- sort: sort of the variable.

    DESCRIPTION:
		- obtains unique variable identifier of
		  the variable with "name" and "sort".
		  it returns 0 if it is not found.

-----------------------------------------------------------------
*/
PUBLIC int
get_var_id (name,sort)
  char *name;
  int  sort;
{
  if (sort == 0)
   sort = kd_v_sort (name);

  if (sort > 0)
    return kd_lfvarid (name,sort);
  else{
    (void) fprintf (stderr, "ldi: sort of \"%s\" not defined\n",name);
    return 0;
  }
}

/*
-----------------   FUNCTION LET_VAR ------------------------------

    PARAMETERS:
		- vid: unique identifier of the variable
		- val: value to assign the variable.

    DESCRIPTION:
		- assign a new value (val) to a variables (vid)
		  it returns 0 when ERROR.
-----------------------------------------------------------------
*/
PUBLIC int
let_var (vid,val)
  int    vid;
  kdatum val;
{
  kdatum l;

  assert (val != NULL);
  assert (var_tbl[-vid].use == NOT_FREE);
  if (vid < 0){
    if(((val->opn > 0) && (var_tbl[-vid].sid!=opn_tbl[val->opn].sid)) ||
       ((val->opn < 0) && (var_tbl[-vid].sid!=var_tbl[-val->opn].sid)))
      return 0;
    if (var_tbl[-vid].value!=NULL){
      kd_free (var_tbl[-vid].value);
    }
    val = kd_copy (val);
    l = kd_rw_node (val);
    if (l != val){
      l = kd_copy (l);
      kd_free (val);
    }
    var_tbl[-vid].value = l;
    return vid;
  }
  return 0;
}

/*
-----------------   FUNCTION DEC_VAR ------------------------------

    PARAMETERS:
		- name: name of the variable to search.
		- sort : sort of the the variable.

    DESCRIPTION:
		- obtains unique variable identifier of the
		  given name. If the variable is not found
		  a new variable is created.

-----------------------------------------------------------------
*/

PUBLIC int
dec_var (name, sort)
	char* name;
	int   sort;
{
  int var = 0;


  var = kd_varid (name,sort);

  if (var < 0){
    var = -var;
  } else {
    (void) fprintf (stderr,"ldi(warning): var \"%s\" redefined\n",name);
  }
  assert (var != 0);
  var_tbl[var].sid=sort;
  var_tbl[var].use=NOT_FREE;
  var_tbl[var].lnk=0;
  if (var_tbl[var].value!=NULL)
    kd_free (var_tbl[var].value);
  var_tbl[var].value = NULL;

  return -var;

}

/*
-----------------   FUNCTION FREE_VAR ------------------------------

    PARAMETERS:
		- vid: unique identifier of the variable

    DESCRIPTION:
		- it frees the variable "vid"
		  0  -> ok
		  #0 -> nok

-----------------------------------------------------------------
*/

PUBLIC int
free_var (vid)
	int   vid;
{
  if ((vid >= 0)|| (var_size < -vid))
    return 1;

  assert (var_tbl[-vid].use == NOT_FREE);
  if (var_tbl[-vid].value!=NULL){
    kd_free (var_tbl[-vid].value);
  }
  var_tbl[-vid].sid=0;
  var_tbl[-vid].value = NULL;
  var_tbl[-vid].name  = NULL;
  var_tbl[-vid].use   = IS_FREE;
  var_tbl[-vid].lnk   = 0;
  return 0;
}

/*
-----------------   FUNCTION RESET_VAR ------------------------------

    PARAMETERS:
		- vid: unique identifier of the variable

    DESCRIPTION:
		- it reset the value of the varieble "vid"
		  0  -> ok
		  #0 -> nok

-----------------------------------------------------------------
*/

PUBLIC int
reset_var (vid)
	int   vid;
{
  if ((vid >= 0)|| (var_size < -vid))
    return 1;

  assert (var_tbl[-vid].use == NOT_FREE);
  if (var_tbl[-vid].value!=NULL)
    kd_free (var_tbl[-vid].value);
  var_tbl[-vid].value = NULL;
  var_tbl[-vid].lnk = 0;
  return 0;
}


/*
-----------------   FUNCTION GET_VALUE ------------------------------

    PARAMETERS:
		- vid: unique identifier of the variable

    DESCRIPTION:
		- it returns the value of variable with "vid"
		  The value is a kdatum.
		  it returns NULL when no value is defined.
-----------------------------------------------------------------
*/
PUBLIC kdatum
get_value (vid)
  int    vid;
{
  if (vid < 0){
    assert (var_tbl[-vid].use == NOT_FREE);
    return var_tbl[-vid].value;
  }
  return NULL;
}

/*
--------------------  GET_VAR_SIZE ------------------------------
    DESCRIPTION:
		 - It returns the current size of the value table
-----------------------------------------------------------------
*/
PUBLIC int
get_var_size ()
{
  return var_size;
}

/*
--------------------  GET_OPN_SIZE ------------------------------
    DESCRIPTION:
		 - It returns the current size of the opn table
-----------------------------------------------------------------
*/
PUBLIC int
get_opn_size ()
{
  return opn_tbl_size;
}

PUBLIC void
display (item)
	int item;
{
  int i;
  int n;

  switch (item){
    case DSORTS :
	  (void) printf ("\nSORTS: \n");
	  for (n=0;n<sort_tbl_size;n++)
	    if (sort_tbl[n].name!=NULL)
	      (void)printf ("* %s\n",sort_tbl[n].name);
	  break;
    case DOPNS:
	  (void) printf ("\nOPERATIONS: \n");
	  for (n=0;n<opn_tbl_size;n++)
	    if (opn_tbl[n].name!=NULL){
	      if (opn_tbl[n].isinfix == FALSE)
		(void) printf ("*   %s:  ",opn_tbl[n].name);
	      else
		(void) printf ("* _ %s _:",opn_tbl[n].name);
	      for (i=0;i<opn_tbl[n].narg;i++){
		(void) printf ("%s",sort_tbl[opn_tbl[n].sarg[i]].name);
		if (i != opn_tbl[n].narg - 1)
		  (void) printf (" , ");
	      }
	      (void) printf (" -> %s\n",sort_tbl[opn_tbl[n].sid].name);
	    }
	  break;
    case DEQNS:
	  (void) printf ("\nEQUATIONS: \n");
	  for (n=0;n<eqn_tsize;n++){
	    if (eqn_tbl[n].eqnstr!=NULL)
	      (void) printf ("* %s\n",eqn_tbl[n].eqnstr);
	  }
	  break;
    case DVARS:
	  (void) (void) printf ("\nVARIABLES: \n");
	  for (n=0;n<var_size;n++){
	    if (var_tbl[n].use==NOT_FREE){
	      (void) printf ("* %s",var_tbl[n].name);
	      if (var_tbl[n].value!=NULL)
		(void) printf (" = %s",kd_draw(var_tbl[n].value));
	      (void) printf (" ofsort %s \n",sort_tbl[var_tbl[n].sid].name);
	    }
	  }
	  break;
    default:
      ldireport ("display");
  }
}

/*****  debug and trace functions ******/

PUBLIC void
ldistat (stval)
	int	stval;
{
  int n;

  switch (stval){
    case 0:
      (void) printf ("\nNumber of rewritings: %d\n",nor);
      break;
    case 1:
      (void) printf ("\nNumber of rewritings: %d\n",nor);
      for (n=0;n<eqn_tsize;n++){
	if (eqn_tbl[n].eqnstr!=NULL&&eqn_tbl[n].counter>0)
	  (void) printf ("%s ----> %d \n",eqn_tbl[n].eqnstr,eqn_tbl[n].counter);
      }
      break;
    default:
      ldireport ("incorrect stat level");
  }
}

PUBLIC void
reset ()
{
  int n;

  for (n=0;n<eqn_tsize;n++)
    eqn_tbl[n].counter = 0;

  nor = 0;

}

PUBLIC void
showdeb ()
{

  (void) printf ("setdeb:");
  if ((seqn == 0 ) && (sr==0))
    (void) printf ("0");
  else if ((seqn == 1 ) && (sr==0))
    (void) printf ("1");
  else if ((seqn == 1 ) && (sr==1))
    (void) printf ("2");
  else
    ldireport (" incorrect debug level ");

}
PUBLIC void
setdeb (level)
	char* level;
{
  if (strlen (level) != 1)
    ldireport (" incorrect debug level ");
  switch (level[0]){
    case '0':
      sr=0;
      seqn=0;
      break;
    case '1':
      sr=0;
      seqn=1;
      break;
    case '2':
      sr=1;
      seqn=1;
      break;
    default:
      ldireport (" incorrect debug level ");
  }
  showdeb ();
}

PUBLIC void
showtrace ()
{

  if (trace == 2 )
    (void) printf ("trace: ECHO ");
  else if (trace == 1 )
    (void) printf ("trace: ON ");
  else
    (void) printf ("trace: OFF");

}

PUBLIC void
settrace (level)
	char* level;
{
  if (strcasecmp (level, "ECHO") == 0){
    trace = 2;
  } else if (strcasecmp (level, "ON") == 0){
    trace = 1;
  } else if (strcasecmp (level, "OFF") == 0){
    trace = 0;
  } else
    ldireport (" incorrect trace option");
  showtrace ();
}

/* it links v1 with v2 variable.
   both v1 and v2 must be declared
   loops are detected.
   TRUE: ok
   FALSE: error
*/
PUBLIC int
lnk (v1, v2)
	int v1;
	int v2;
{
  assert (-v1 <= var_tbl_size);
  assert (-v2 <= var_tbl_size);

  assert (var_tbl[-v1].use == NOT_FREE);
  assert (var_tbl[-v2].use == NOT_FREE);

  if (var_tbl[-v1].lnk != 0)
    return FALSE;

  if (!chk_lnk (v1, v2)){
    var_tbl[-v1].lnk = v2;
    return TRUE;
  } else {
    return FALSE;
  }
}

PUBLIC  int
get_lnk (vid)
	int vid;
{
  int lnkvid;

  assert (-vid <= var_tbl_size);
  assert (var_tbl[-vid].use == NOT_FREE);

  if (var_tbl[-vid].lnk == 0){
    return vid;
  } else {
    return get_lnk (var_tbl[-vid].lnk);
  }
}


/******** kdatum builder functions *******/
PUBLIC kdatum
mkprefix (fath, son, sons)
	kdatum  fath;
	klink   son;
	int     sons;
{
  if ((fath == NULL) || ((son == NULL)&& (sons == TRUE)))
    fath = NULL;
  else{
    fath->lnk = son;
    if (son !=NULL)
      son->arg = kd_copy(son->arg);
  }
  return fath;
}

PUBLIC kdatum
mkinfix (fath, son1, son2)
	kdatum  fath;
	kdatum  son1;
	kdatum  son2;
{
  klink s1;
  klink s2;

  if ((fath == NULL) || (son1 == NULL) || (son2 == NULL)){
    fath = NULL;
  } else {
    s1 = kd_link ();
    s2 = kd_link ();

    s1->arg = son1;
    s1->next=s2;

    s2->arg = son2;
    s2->next=NULL;

    fath->lnk = s1;
    if (son1 != NULL)
      son1 = kd_copy (son1);
    if (son2 != NULL)
      son2 = kd_copy (son2);
  }
  return fath;
}
PUBLIC klink
lnsnode (onode, snode)
	kdatum  onode;
	klink   snode;
{
  klink s1;

  if (onode == NULL){
    s1 = NULL;
  } else {
    s1 = kd_link ();
    s1->arg= onode;
    s1->next= snode;
    if (snode != NULL)
      snode->arg = kd_copy (snode->arg);
  }

  return s1;
}

PUBLIC kdatum
mknode (op)
	int     op;
{
  kdatum        node;

  if (op == 0){
    node = NULL;
  } else if (op>0) {
    node=kd_alloc();
    node->opn=op;
    node->lnk=NULL;
  } else {
    node=kd_alloc();
    node->opn=op;
    node->lnk=NULL;
  }
  return node;
}
