/***********************************
  (C) Copyright 1992-1993; dit/upm
  Distributed under the conditions stated in the
  TOPO General Public License (see file LICENSE)
  ***********************************/

/***********************************

  Santiago Pavon Gomez

  27 March 1990

  Reads files with LOTOS specifications in the EPS (El Prado System) format
  and fills the internal data structures of the module BA to represent this
  specification.

  ************************************/


#include "cast.hh"
#include "batables.h"
#include "limisc.h"
#include "lihash.h"
#include "listdout.h"
#include "nodes.h"
#include "grc.h"
#include "batransl.h"
#include "baattr.h"
#include "babool.h"
#include "bainit.h"
#include "badefca.h"
#include "balotosf.h"
#include "expre_br.h"

/******************************************************************
 *
 *    Interface with EPS (El Prado System)
 *
 *******************************************************************/

/*
 * EPS cell types
 */


#include "colours.h"

TIOCOLOURS iocolours [] = {             /* io driver */
#include "colours.c"
			  NULL,      others,    IO_ign
};


/* Look_iddec
 * Returns the iddec attribute of the TNODE "p".
 */
#define Look_iddec(p)         Look_iattr(c_iddec,p)


/* Look_idref
 * Returns the idref attribute of the TNODE "p".
 */
#define Look_idref(p)         Look_iattr(c_idref,p)

/* Exist_brother
 * TRUE if the TNODE "p" has a brother.
 */
#define Exist_brother(p)    (!t_brother(p))

/* Exist_son
 * TRUE if the TNODE "p" has a son.
 */
#define Exist_son(p)        (!t_leaf(p))

/* Look_brother
 * Returns the brother of the TNODE "p".
 */
#define Look_brother(p)     (gt_rb(p))

/* Look_son
 * Returns the son of the TNODE "p".
 */
#define Look_son(p)         (gt_fs(p))

/* Look_class
 * Returns the class of the TNODE "p".
 */
#define Look_class(p)       ((int)((p)->value1))

/* Look_rule
 * Returns the rule number of the TNODE "p".
 */
#define Look_rule(p)        ((grnl->data[(int)((p)->value0)])[0])

/* Look_type
 * Returns the type of the TNODE "p".
 */
#define Look_type(p)        ((p)->type)

/* Is_Infix
 * Returns TRUE if the operation represented by the TNODE "p" is infix.
 */
#define Is_Infix(p)         (find_attr(c_infix,p) != NULL)

/* Look_line
 * Returns the line attribute of the TNODE "p".
 */
#define Look_line(p)         Look_iattr(c_line,p)

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

static TNODE*  astroot;
static TNODE*  atastroot;
static AT*     ATable;
static IAT*    grnl;
static ST*     SymbolTable;

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

/* Look_iattr
 * Looks for the attibute "attr" in the node "ptr".
 */
/* KJT 25/01/23: changed return type from "int" to "CLR_TYPE" */
static CLR_TYPE Look_iattr(attr,ptr)
     int    attr;
     TNODE* ptr;
{
  TATTR* ptrcolor;

  ptrcolor = find_attr(attr,ptr);
  if (ptrcolor == NULL)
    return (0);
   /* KJT 25/01/23: removed cast to "int" */
   return ptrcolor->value;
}

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

/* Look_idclass
 * Returns the "idclass" of the node "ptr".
 */
static int Look_idclass(ptr)
     TNODE* ptr;
{
  TATTR* i;

  LASSERT(printError!=NULL);
  if ( (i=find_attr(c_idref,ptr)) == NULL )
    if ( (i = find_attr(c_iddec,ptr)) == NULL ) {
      Error("Translator: idclass coluor does not exist.");
    }
  return (int) (ATable->data[(int)(i->value)]).value0;
}

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

/* Look_lexv
 * Returns the "lexv" of the node "ptr".
 */
static char * Look_lexv (ptr)
     TNODE* ptr;
{
  TATTR* i;
  int lexv;

  if ((i=find_attr(c_idref,ptr))==NULL)
    if ((i=find_attr(c_iddec,ptr))==NULL)
      return NULL;
  lexv = (int)(ATable->data[(int)(i->value)]).value1;
  LowerString(SymbolTable->data[lexv]);
  return SymbolTable->data[lexv];
}

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

/* Look_root
 * Opens and restores the tree  in the file "nomb_fich".
 */
static TNODE* Look_root(nomb_fich)
     char * nomb_fich;
{
  FILE *fich;
  char rootname[BUFSIZ];

  LASSERT(printError!=NULL);
  astroot = NULL;
  atastroot = NULL;
  if ((fich = fopen(nomb_fich,"r")) == NULL ) {
    printError("\n      I can not open file <");
    printError(nomb_fich);
    printError(">.\n");
    return NULL;
  }
  astroot = restore (fich);
  (void) fclose(fich);
  if (astroot == NULL) {
    printError("\n      I can not restore file <");
    printError(nomb_fich);
    printError(">.\n");
    return NULL;
  }
  {
    char *s;
    (void) strcpy (rootname, nomb_fich);
    s    = strchr(rootname,'.');
    s[0] = '\0';
  }
#ifdef EXTENSION_AT
  (void) strcat (rootname, ".at");
#else
  (void) strcat (rootname, ".asf");
#endif
  if ((fich= fopen (rootname, "r")) == NULL) {
    printError("\n      I can not open file <");
    printError(rootname);
    printError(">.\n");
    return NULL;
  }
  atastroot = restore(fich);
  (void) fclose(fich);
  if (atastroot == NULL) {
    printError("\n      I can not restore file <");
    printError(rootname);
    printError(">.\n");
    return NULL;
  }
  SymbolTable = (ST*) find_attr (c_ll, atastroot)->value;
  ATable = (AT*) find_attr (c_at, atastroot)->value;
  grnl = (IAT*) find_attr (c_grnl, astroot)->value;
  return astroot;
}

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

/* Free_astroot
 * Deallocates the memory used by the astroot tree.
 */
static void Free_astroot()
{
  kill_tree(astroot);
  /*
     kill_tree(atastroot);
     */
}


/******************************************************************
 *
 *   Tables to map the EPS uniq identifiers with
 *   the lola uniq identifiers.
 *
 *******************************************************************/


#define MAX_MAP_TAB 1000


typedef struct { int           decref;
		 DescriptorTyp nd;
	       } ElemTyp, *PElemTyp;

static HashDTyp MT;

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

/* CreateElem_MT
 * Gets memory for a new element.
 */
static PElemTyp CreateElem_MT()
{
  return (PElemTyp) emalloc(sizeof(ElemTyp));
}

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

/* FreeElem_MT
 * Deallocates the memory of the element "pe".
 */
static void FreeElem_MT(pe)
     PElemTyp pe;
{
  free((char*)pe);
}

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

/* KeyElem_MT
 * Calculates the key of the element "pe".
 */
static int KeyElem_MT(pe)
     PElemTyp pe;
{
  return pe->decref;
}

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

/* CompElem_MT
 * Compares the elements "pe1" and "pe2".
 */
static boolean CompElem_MT(pe1,pe2)
     PElemTyp pe1, pe2;
{
  return pe1->decref == pe2->decref;
}

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

/* PrintElem_MT
 * Prints the element "pe".
 * "pstr" is the function used to print strings.
 */
static void PrintElem_MT(pstr,pe)
     PElemTyp pe;
     void (*pstr)();
{
  pstr("< ");
  PrintInt(pstr,pe->decref);
  pstr(" , ");
  PrintInt(pstr,pe->nd);
  pstr(" > ");
}

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

/* Init_map_tab
 * Init the mapping tables.
 */
static void Init_map_tab()
{
  MT = Create_HT(MAX_MAP_TAB,FreeElem_MT, KeyElem_MT, CompElem_MT, PrintElem_MT);
}

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

/* New_map_entry
 * Insert the pair <nd,decref> in the mapping table.
 */
static void  New_map_entry( nd, decref )
     DescriptorTyp nd;
     int  decref;
{
  PElemTyp pe;

  pe = CreateElem_MT();
  pe->nd = nd;
  pe->decref = decref;
  LASSERT(!In_HT(MT,(DataHashTyp)pe));
  Insert_HT(MT,(DataHashTyp)pe);
}

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

static ElemTyp e_aux;

/* Desref_To_nd
 * Returns the descriptor associated to a given idref or iddef.
 * Returns 0 if not found.
 */
static DescriptorTyp Desref_To_nd( decref )
     int  decref;
{
  PElemTyp pe;

  e_aux.decref = decref;
  pe = (PElemTyp)LookFor_HT(MT,(DataHashTyp)(&e_aux));
  /* KJT 18/05/02: changed "NULL ? NULL : pe->nd" to "NULL ? 0 : pe->nd" */
  return pe == NULL ? 0 : pe->nd;
}

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

/* Free_map_tab
 * Cleans the mapping table.
 */
static void Free_map_tab()
{
  Free_HT(MT);
}

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

/* Declare_MOpn
 * Defines an operation. It is inserted in the mapping tables and it
 * is declared in the operation table.
 */
static void Declare_MOpn( n,al,s,decref,infix,rwlist )
     char * n;
     ListTyp al;
     int  s, decref;
     boolean infix;
     RewRuleListTyp rwlist;
{
  DescriptorTyp nd;

  LASSERT (decref != NULL);
  nd = Declare_opn(n,al,Desref_To_nd(s),infix,rwlist);
  New_map_entry(nd,decref);
}

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

/* DeclareMVar
 * Defines a variable. It is inserted in the mapping tables and it
 * is declared in the variable table.
 */
static DescriptorTyp DeclareMVar( n,s,decref )
     char * n;
     int  s,decref;
{
  DescriptorTyp nd;

  LASSERT (decref != NULL);
  nd = Declare_var(n,Desref_To_nd(s));
  New_map_entry(nd,decref);
  return nd;
}

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

/* Declare_MSort
 * Defines a sort. It is inserted in the mapping tables and it
 * is declared in the sort table.
 */
static DescriptorTyp Declare_MSort( n,decref )
     char * n;
     int  decref;
{
  DescriptorTyp nd;

  LASSERT (decref != NULL);
  nd = Declare_sort(n);
  New_map_entry(nd,decref);
  return nd;
}

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

/* Declare_MProc
 * Defines a process. It is inserted in the mapping tables and it
 * is declared in the process table.
 */
static DescriptorTyp Declare_MProc( n,def,funclity,decref )
     char       * n;
     BehTyp     def;
     int        funclity;
     int        decref;
{
  DescriptorTyp nd;

  LASSERT (decref != NULL);
  nd = Declare_proc(n,def,funclity);
  New_map_entry(nd,decref);
  return nd;
}


/******************************************************************
 *
 *   Data Value Expression translations
 *
 *******************************************************************/


/* Tra_val_exp
 * Translate a value expression.
 * ve points to a _value_expression node.
 */
static ExprTyp Tra_val_exp( ve )
     TNODE* ve ;
{
  ExprTyp op;
  TNODE*  opa;
  DescriptorTyp id;

  LASSERT(ve != NULL);
  LASSERT(Look_type(ve)==tvalue_expression);
  if (Look_idclass(ve)==7) { /*Variable*/
    id = Desref_To_nd(Look_idref(ve));
    if (id == 0)
      Error("expression: variable undeclared.");
    return MakeE(id,VariableC);
  }
  else {
    LASSERT(Look_idclass(ve)==4);
    id = Desref_To_nd( Look_idref(ve));
    if (id == 0)
      Error("expression: operation undeclared.");
    op = MakeE(id,OperationC);
    opa = Look_son(ve);
    while (opa!=NULL) {
      AddArgE(op,Tra_val_exp(opa));
      opa = Look_brother(opa);
    }
    return op;
  }
}

/******************************************************************
 *
 *   Data type definition translation. (ACT-ONE ADT.)
 *
 *******************************************************************/


/* LoadIdDecls
 * Load the variable declarations in the table.
 * v points to a _identifier_declarations node.
 */
static void LoadIdDecls (v)
     TNODE* v ;
{ TNODE* id;
  int    sort;

  LASSERT(Look_type(v)==tidentifier_declarations);
  v =  Look_son(v);
  while ( v != NULL ) {
    /* KJT 25/01/23: added cast to "int) */
    sort =  (int) Look_idref(Look_brother(Look_son(v)));
    id =  Look_son(Look_son(v));
    while ( id != NULL ) {
      (void)DeclareMVar(Look_lexv(id), sort, Look_iddec(id) );
      id = Look_brother( id);
    }
    v =  Look_brother(v);
  }
}

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

/* LoadSorts
 * Loads the sorts of a type.
 * s points to a _sorts node.
 */
static void LoadSorts(s)
     TNODE* s;
{
  int iddec;

  LASSERT(Look_type(s)==tsorts);
  s =  Look_son(s);
  while (s != NULL) {
    /* KJT 25/01/23: added cast to "int) */
    iddec =  (int) Look_iddec(Look_son(s));
    (void) Declare_MSort(Look_lexv(Look_son(s)),iddec);
    s =  Look_brother(s);
  }
}

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

/* LoadOpns
 * Loads the operations of a type.
 * e points to a _operations node.
 */
static void LoadOpns (opns)
     TNODE* opns;
{ TNODE *o, *p, *pide, *a ;
  char   *nameopn;
  int    sort;
  ListTyp al;

  LASSERT(Look_type(opns)==toperations);
  for (o=Look_son(opns);o!=NULL;o=Look_brother(o)) {
    p = Look_brother(Look_son(o));
    if (Look_type(p)==targument_list) {
      al = Create_list();
      for (a=Look_son(p);a!=NULL;a=Look_brother(a))
	al = Add_list((DataListTyp)Desref_To_nd(Look_idref(a)),al);
      p = Look_brother(p);
    }
    else
      al = Create_list();
    /* KJT 25/01/23: added cast to "int) */
    sort= (int) Look_idref(p);
    pide= Look_son(Look_son(o));
    while ( pide != NULL ) {
      nameopn =  Look_lexv(Look_son(pide));
      Declare_MOpn(nameopn,
		   Copy_list(al,(DataListTyp(*)())EchoInt),
		   sort,
		   Look_iddec(Look_son(pide)),
		   Look_rule(pide) == _operation_descriptor_2,
		   Create_list());
      pide= Look_brother(pide);
    }
    Disp_list(al);
  }
}

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

/* Tra_premisses
 * Translates and loads the premisses of a equation in the table.
 * p points to a _premisses node.
 */
static ExprListTyp  Tra_premisses (p)
     TNODE* p ;
{ ExprListTyp lp;
  ExprTyp e;

  LASSERT(Look_type(p)==tpremisses);
  lp = CreateEL();
  p =  Look_son(p);
  while ( p ) {
    e = MakeE(GetEqual(),OperationC);
    AddArgE(e,Tra_val_exp(Look_son(p)));
    AddArgE(e,Tra_val_exp(Look_brother(Look_son(p))));

    lp = InsertEL(e,lp);
    p =  Look_brother(p);
  }
  return lp;
}

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

/* Tra_equation
 * Translates and loads a equation in the table.
 * e points to a _equation node.
 */
static void Tra_equation (e)
     TNODE* e ;
{ TNODE* aux;
  ListTyp  pre;
  ExprTyp ve1, ve2;

  LASSERT(Look_type(e)==tequation);
  aux =  Look_son(e);
  if (Look_type(aux)==tpremisses)
    { pre = Tra_premisses(aux);
      aux = Look_brother(aux);
    }
  else
    pre = NULL;
  aux = Look_son(aux);
  ve1 = Tra_val_exp(aux);
  aux = Look_brother(aux);
  ve2 = Tra_val_exp(aux);
  PutO_rw(ve1,ve2,pre);
}

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

/* LoadEqns
 * Loads the equations of a type.
 * e points to a _equations node.
 */
static void LoadEqns( e )
     TNODE* e ;
{
  TNODE  *aux, *in;

  LASSERT(Look_type(e)==tequations);
  aux= Look_son(e);
  if (Look_type(aux)==tidentifier_declarations)
    {  LoadIdDecls(aux);
       aux= Look_brother(aux);
     }
  aux = Look_son(aux);
  while (aux!=NULL)
    {  in = Look_brother(Look_son(aux));
       if (Look_type(in)==tidentifier_declarations)
	 {  LoadIdDecls(in);
	    in =  Look_brother(in);
	  }
       in = Look_son(in);
       while (in!=NULL)
	 {  Tra_equation(in);
	    in =  Look_brother(in);
	  }
       aux = Look_brother(aux);
     }
}

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

/* LoadTypes
 * Loads the types of a specification.
 * t points to a _data_type_definitions node.
 */
static void LoadTypes ( t )
     TNODE* t ;
{
  LASSERT(Look_type(t)==tdata_type_definitions);
  if ( Look_son(t)!=NULL ) {
    t =  Look_son(t);
    if (Look_type(t) != ttype_definition)
      Error("fflt: bad flattening.");
    LASSERT(Look_brother(t)==NULL);
    t =  Look_son(t);
    t =  Look_son(Look_brother(t));
    while ( Exist_brother(t) )
      t =  Look_brother(t);
    LASSERT(Look_type(t)==tp_specification);
    t= Look_son(t);
    LASSERT(Look_type(t)!=tformal_sorts);
    LASSERT(Look_type(t)!=tformal_operations);
    LASSERT(Look_type(t)!=tformal_equations);
    while ( (t!= NULL) ) {
      if( Look_type(t)==tsorts )
	LoadSorts(t);
      else if( Look_type(t)==toperations )
	LoadOpns(t);
      else if( Look_type(t)==tequations )
	LoadEqns(t);
      t =  Look_brother(t);
    }
  }
}

/******************************************************************
 *
 *   Behaviour translation.
 *
 *******************************************************************/

static BehTyp Tra_Beh ();


/* Tra_val_iddecls
 * Translates a declaration of variables.
 * vdl points to a _identifier_declarations node.
 */
static ExprListTyp Tra_val_iddecls(vdl)
     TNODE* vdl ;
{
  ExprListTyp el;
  ExprTyp v;
  TNODE *dec, *id;
  int    sort;

  LASSERT(Look_type(vdl)==tidentifier_declarations);
  el = NULL;
  dec =  Look_son(vdl);
  while ( dec != NULL ) {
    /* KJT 25/01/23: added cast to "int) */
    sort =  (int) Look_idref(Look_brother(Look_son(dec)));
    id =  Look_son(Look_son(dec));
    while ( id != NULL ) {
      v = MakeE(DeclareMVar(Look_lexv(id),sort,Look_iddec(id)),VariableC);
      el = AddEL(v,el);
      id =  Look_brother(id);
    }
    dec =  Look_brother(dec);
  }
  return el;
}

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

/* Tra_loc_def_exp
 * Translates the _local_definition_expression pointed by lde.
 */
static BehTyp  Tra_loc_def_exp (lde)
     TNODE* lde ;
{
  BehTyp let, beh;
  ExprTyp ptra, exp;
  TNODE *ie, *ve, *id;
  int    sort;
  VarAssignListTyp val;
  DescriptorTyp  v;

  val = CreateVAL();
  let = MakeB(0,LetC);
  ie =  Look_son(Look_son(lde));
  while ( ie )
    {
      /* KJT 25/01/23: added cast to "int) */
      sort = (int)  Look_idref(Look_brother(Look_son(Look_son(ie))));
      id =  Look_son(Look_son(Look_son(ie)));
      ve =  Look_brother(Look_son(ie));
      exp =  Tra_val_exp(ve);
      while ( id )
	{ v = DeclareMVar(Look_lexv(id),sort,Look_iddec(id));
	  if (Exist_brother(id))
	    ptra= CopyE(exp);
	  else /*mse*/
	    ptra= exp;
	  val = AddVAL(val,v,ptra);
	  id =  Look_brother(id);
	}
      ie =  Look_brother(ie);
    }
  beh =  Tra_Beh(Look_brother(Look_son(lde)));
  AddArgB(let, beh);
  PutA(let,MakeA((AttrValueTyp)val,VALA));
  return let;
}

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

/* Tra_gat_set
 * Translates the _gate_declaration_list "gdl" to a GateSetTyp.
 */
static GateSetTyp  Tra_gat_set (gdl)
     TNODE* gdl ;
{
  GateSetTyp  gs;

  gs = NewGS();
  gdl = Look_son(gdl);
  while ( gdl != NULL )
    { gs = AddGS(gs,Store_gate(Look_lexv(gdl)));
      gdl = Look_brother(gdl);
    }
  return gs;
}

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

/* Tra_gat_list
 * translates the _gate_declaration_list gdl to a GateListTyp.
 */
static GateListTyp  Tra_gat_list (gdl)
     TNODE* gdl ;
{
  GateListTyp  gl;

  LASSERT((Look_type(gdl) == tgate_declaration_list) ||
	  (Look_type(gdl) == tgate_list) ||
	  (Look_type(gdl) == tidentifier_declaration_list));
  gl  = Create_list();
  gdl = Look_son(gdl);
  while ( gdl != NULL ){
    gl  = AddGL(Store_gate(Look_lexv(gdl)),gl);
    gdl = Look_brother(gdl);
  }
  return gl;
}

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

/* Tra_gat_dec
 * Translates a gate_declaration
 */
static PGateDecTyp Tra_gat_dec(gd)
     TNODE* gd;
{
  GateSetTyp gs;
  GateListTyp gl;

  LASSERT(Look_type(gd)==tgate_declaration);
  gl = Tra_gat_list(Look_brother(Look_son(gd)));
  gs = Tra_gat_set(Look_son(gd));
  return MakeGD(gl,gs);
}

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

/* Tra_gat_dec_list
 * Translates a gate_declarations
 */
static GateDecListTyp Tra_gat_dec_list(gdl)
     TNODE* gdl;
{
  GateDecListTyp pl;

  pl = CreateGDL();
  gdl = Look_son(gdl);
  while (gdl!=NULL) {
    pl = AddGDL(Tra_gat_dec(gdl),pl);
    gdl = Look_brother(gdl);
  }
  return pl;
}

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

/* Tra_ato_exp
 * Translates the _atomic_expression pointed by ate.
 */
static BehTyp  Tra_ato_exp (ate)
     TNODE* ate ;
{
  BehTyp        p1;
  TNODE        *pof;
  char         *any_sort, *sort;
  OfferListTyp  ol;
  int          *v;

  switch ( Look_rule(ate) )
    { case _atomic_expression_1: /* stop */
	p1 = MakeB(0,StopC);
	return p1;

      case _atomic_expression_3:  /* (beh) */
	if (Look_type(Look_son(ate))==texecutable_comment_list)
	  return Tra_Beh(Look_brother(Look_son(ate)));
	else
	  return Tra_Beh(Look_son(ate));

      default:
	if (Look_class(ate)<2) { /* exit */
	  p1 = MakeB(0,ExitC);
	  /* line & file */
	  v = (int*)Look_line( ate );
	  if ( v!=0 ){
	    PutA( p1, MakeA((AttrValueTyp)v[0],SSLA) );
	  }
	  return p1;
	}
	else { /* exit(.....) */
	  p1 = MakeB(0,ExitC);
	  ol = CreateOL();

	  pof =  Look_son(ate);
	  if (Look_type(pof)==texecutable_comment_list)
	    pof =  Look_son(Look_brother(pof));
	  else
	    pof =  Look_son(pof);
	  while ( pof ) {
	    if (Look_type(pof)==tvalue_expression )
	      ol = AddOL(MakeOffer(EXCLAMATION,Tra_val_exp(pof)),ol);
	    else {
	      sort = Look_lexv(pof);
	      any_sort = (char*) emalloc(strlen(sort)+5);
	      (void)sprintf(any_sort,"any_%s",sort);
	      ol = AddOL(MakeOffer(QUESTION,
				   MakeE(Declare_var(any_sort,FindS(sort)),
					 VariableC)),
			 ol);
	    }
	    pof =  Look_brother(pof);
	  }
	  PutA(p1,MakeA((AttrValueTyp)ol,OLA));
	  /* line & file */
	  v = (int*)Look_line( ate );
	  if ( v!=0 ){
	    PutA( p1, MakeA((AttrValueTyp)v[0],SSLA));
	  }
	  return p1;
	}
      }
}

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

/* Tra_Act_Gat_List
 * Translates the _actual_gate_list pointed by agl.
 */
static GateListTyp  Tra_Act_Gat_List (agl)
     TNODE* agl ;

{
  LASSERT(Look_type(agl)==tactual_gate_list);
  return Tra_gat_list(Look_son(agl));
}

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

/* Tra_Act_Exp_List
 * Translates the _value_expression_list pointed by apl.
 */
static ExprListTyp  Tra_Act_Exp_List (apl)
     TNODE* apl ;
{
  ExprListTyp el;
  TNODE* ve;

  LASSERT(Look_type(apl)==tvalue_expression_list);
  el = CreateEL();
  ve= Look_son(apl);
  while ( ve )
    { el = AddEL(Tra_val_exp(ve),el);
      ve =  Look_brother(ve);
    }
  return el;
}

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

/* Tra_proc_inst
 * Translates the _process_instantiation pointed by ppi.
 */
static BehTyp  Tra_pro_inst (ppi)
     TNODE* ppi ;
{
  BehTyp        pp;
  TNODE       * pide;
  DescriptorTyp ndp;
  int         * v;

  pide =  Look_son(ppi);
  if (Look_type(pide)==texecutable_comment_list)
    pide = Look_brother(pide);
  LASSERT(Look_type(pide)==tprocess_identifier);
  ndp = Desref_To_nd(Look_idref(pide));
  if (ndp == 0)
    ndp = Declare_MProc(Look_lexv(pide), (BehTyp)NULL,
			NOTCALCULATEDF, Look_idref(pide));
  pp = MakeB(ndp,ProcessInstC);
  v = (int*)Look_line( pide );
  if ( v!=0 ){
    PutA( pp, MakeA((AttrValueTyp)v[0],SSLA) );
  }
  switch ( Look_class(ppi) )
    { case 3:
      case 2: /* sin parametros */
	/* nada */
	break;
      case 7:
      case 6:  /* _actual_gate_list */
	pide = Look_brother(pide);
	PutA(pp,MakeA((AttrValueTyp)Tra_Act_Gat_List(pide),GLA));
	break;
      case 11:
      case 10: /* _value_expression_list */
	pide = Look_brother(pide);
	PutA(pp,MakeA((AttrValueTyp)Tra_Act_Exp_List(pide),ELA));
	break;
      case 15:
      case 14:  /* _actual_gate_list   _value_expression_list  */
	pide = Look_brother(pide);
	PutA(pp,MakeA((AttrValueTyp)Tra_Act_Gat_List(pide),GLA));
	pide = Look_brother(pide);
	PutA(pp,MakeA((AttrValueTyp)Tra_Act_Exp_List(pide),ELA));
	break;
      }
  return pp;
}

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

/* Tra_exp_off_list
 * Translates the _experiment_offer_list pointed by ptreol.
 */
static OfferListTyp  Tra_exp_off_list (eol)
     TNODE* eol ;
{
  OfferListTyp ol;
  ExprTyp pvar;
  TNODE *pexp, *pide, *v;
  char   *nombrevar;
  int    sort;

  ol = CreateOL();
  pexp =  Look_son(eol);
  while ( pexp ) {
    switch ( Look_rule(pexp) )
      { case _experiment_offer_1: /* ? */
	  /* KJT 25/01/23: added cast to "int) */
	  sort =  (int) Look_idref(Look_brother(Look_son(pexp)));
	  pide =  Look_son(Look_son(pexp));
	  while ( pide ) {
	    if (Look_type(pide)!=tidentifier)
	      v = Look_son(pide);
	    else
	      v = pide;
	    nombrevar =  Look_lexv(v);
	    pvar = MakeE(DeclareMVar(nombrevar,sort,Look_iddec(v)),
			 VariableC);
	    ol = AddOL(MakeOffer(QUESTION,pvar),ol);
	    pide =  Look_brother(pide);
	  }
	  break;
	case _experiment_offer_2: /* ! */
	  ol = AddOL(MakeOffer(EXCLAMATION,
			       Tra_val_exp(Look_son(pexp))),ol);
	  break;
	}
    pexp =  Look_brother(pexp);
  }
  return ol;
}

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

/* Tra_premiss
 * Translates a premiss (_value_expression or _simple_equation).
 */
static ExprTyp  Tra_premiss (pre)
     TNODE* pre ;
{
  ExprTyp e,e1,e2;

  e1 = Tra_val_exp(Look_son(pre));
  e2 = Tra_val_exp(Look_brother(Look_son(pre)));
  e = MakeE(GetEqual(),OperationC);
  AddArgE(e,e1);
  AddArgE(e,e2);
  return e;
}

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

/* Tra_sel_pre
 * Translates the selection predicate "psp".
 */
static PredicateTyp  Tra_sel_pre (psp)
     TNODE* psp ;
{
  ExprTyp e;

  LASSERT(Exist_son(psp));
  e = Tra_premiss(Look_son(psp));
  return NewPred(e,CopyE(e));
}

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

/* Tra_act_den
 * Translates the _action_denotation pointed by acd.
 */
static BehTyp  Tra_act_den (acd)
     TNODE* acd ;
{
  BehTyp p;
  TNODE* paux;
  int*   v;

  LASSERT(Look_type(acd)==taction_denotation);
  switch (  Look_rule(acd) ) {
  case _action_denotation_3: /* i */
    p = MakeB(0,IC);

    /* line & file */
    v = (int*)Look_line( acd );
    if ( v!=0 ){
      PutA( p, MakeA((AttrValueTyp)v[0],SSLA));
    }
    /**/
    break;

  case _action_denotation_2:  /* accion visible con ? , ! , predicados */
    paux =  Look_son(acd);
    p    = MakeB(Store_gate(Look_lexv(paux)),GateC);
    paux =  Look_brother(paux);
    PutA( p, MakeA((AttrValueTyp)Tra_exp_off_list(paux),OLA) );
    paux =  Look_brother(paux);
    if (Exist_son(paux))
      PutA(p,MakeA((AttrValueTyp)Tra_sel_pre(paux),PA));
    /* line & file */
    v = (int*)Look_line( Look_son(acd) );
    if ( v!=0 ){
      PutA( p, MakeA((AttrValueTyp)v[0],SSLA));
      /*  file := SymbolTable->data[v[1]] */
    }
    /**/
    break;

  case _action_denotation_1: /* accion visible */
    paux =  Look_son(acd);
    p    = MakeB(Store_gate(Look_lexv(paux)),GateC);
    /* line & file */
    v = (int*)Look_line( Look_son(acd) );
    if ( v!=0 ){
      PutA( p, MakeA((AttrValueTyp)v[0],SSLA));
    }
    /**/
    break;
  }
  return p;
}

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

/* Tra_act_pre_exp
 * Translates the _action_prefix_expression pointed by ape.
 */
static BehTyp  Tra_act_pre_exp (ape)
     TNODE* ape ;
{
  TNODE *pad, *pbeh;
  BehTyp pb, pg;

  pad =  Look_son(ape);
  if (Look_type(pad)!=taction_denotation)
    pad = Look_brother(pad);
  pbeh =  Look_brother(pad);
  pg =  Tra_act_den(pad);
  pb =  Tra_Beh(pbeh);
  AddArgB(pg,pb);
  return pg;
}

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

/* Tra_paral_exp
 * Translates the parallel expression "pe".
 */
static BehTyp  Tra_paral_exp (pe)
     TNODE* pe ;
{
  TNODE* pop;
  BehTyp pp;

  pp  = MakeB(0,ParallelC);
  pe = Look_son(pe);
  AddArgB(pp,Tra_Beh(pe));
  pop = Look_brother(pe);
  AddArgB(pp, Tra_Beh(Look_brother(pop)));
  switch ( Look_rule(pop) )
    { case _parallel_operator_1:  /* sincronizacion */
	PutNameB(pp,FULL_SYNC);
	/* PutA(pp,MakeA(GetGates(pp),GSA)); */
	break;
      case _parallel_operator_2:  /* interleaving */
	PutNameB(pp,INTER_SYNC);
	break;
      case _parallel_operator_3:  /* con puertas */
	PutNameB(pp,PART_SYNC);
	PutA(pp,MakeA((AttrValueTyp)Tra_gat_set(Look_son(pop)),GSA));
	break;
      }
  return pp;
}

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

/* Tra_gua_exp
 * Translates a guarded expression.
 */
static BehTyp Tra_gua_exp (g)
     TNODE* g;
{
  BehTyp pg;
  ExprTyp e;

  pg = MakeB(0,GuardC);
  AddArgB(pg,Tra_Beh(Look_brother(Look_son(g))));
  e = Tra_premiss(Look_son(g));
  PutA(pg,MakeA((AttrValueTyp)NewPred(e,CopyE(e)),PA));
  return pg;
}

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

/* Tra_cho_exp
 * Translates a choice expression.
 */
static BehTyp Tra_cho_exp (a)
     TNODE* a ;
{
  BehTyp pa;

  pa = MakeB(0,AlternativeC);
  while (Look_type(a)==tchoice_expression) {
    a  = Look_son(a);
    AddArgB(pa,Tra_Beh(a));
    a = Look_brother(a);
  }
  AddArgB(pa,Tra_Beh(a));
  return pa;
}

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

/* Tra_dis_exp
 * Translates a disable expression.
 */
static BehTyp Tra_dis_exp (d)
     TNODE* d ;
{
  BehTyp pd;

  pd = MakeB(0,DisablingC);
  d = Look_son(d);
  AddArgB(pd,Tra_Beh(d));
  d = Look_brother(d);
  AddArgB(pd,Tra_Beh(d));
  return pd;
}

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

/* Tra_ena_ope
 * Translates a enable operator.
 */
static ExprListTyp Tra_ena_ope(eo)
     TNODE* eo ;
{
  return Tra_val_iddecls(Look_son(eo));
}

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

/* Tra_ena_exp
 * Translate the _enable_expression pointed by e.
 */
static BehTyp Tra_ena_exp (e)
     TNODE* e;
{
  BehTyp ena;

  ena = MakeB(0,EnablingC);
  e = Look_son(e);
  AddArgB(ena,Tra_Beh(e));
  e = Look_brother(e);
  if (Exist_son(e))
    PutA(ena,MakeA((AttrValueTyp)Tra_ena_ope(e),ELA));
  e = Look_brother(e);
  AddArgB(ena,Tra_Beh(e));
  return ena;
}

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

/* Tra_hid_exp
 * Translate the _hiding_expression pointed by h.
 */
static BehTyp Tra_hid_exp (h)
     TNODE* h ;
{
  BehTyp ph;

  ph = MakeB(0,HidingC);
  AddArgB(ph,Tra_Beh(Look_brother(Look_son(h))));
  PutA(ph,MakeA((AttrValueTyp)Tra_gat_set(Look_son(h)),GSA));
  return ph;
}

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

/* Tra_sum_puer
 * Translates a sum_expression of gates.
 */
static BehTyp  Tra_sum_puer (s)
     TNODE* s;
{
  BehTyp p;

  p = MakeB(0,GateChoiceC);
  PutA(p,MakeA((AttrValueTyp)Tra_gat_dec_list(Look_son(s)),GDLA));
  AddArgB(p,Tra_Beh(Look_brother(Look_son(s))));
  return p;
}

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

/* Tra_sum_val
 * Translates a sum expression of values.
 * s points to a _sum_expression node.
 */
static BehTyp Tra_sum_val (s)
     TNODE* s;
{
  BehTyp p;

  p = MakeB(0,ChoiceC);
  PutA(p,MakeA((AttrValueTyp)Tra_val_iddecls(Look_son(s)),ELA));
  AddArgB(p,Tra_Beh(Look_brother(Look_son(s))));
  return p;
}

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

/* Tra_sum_exp
 * Translates a sum expression of values or gates.
 * s points to a _sum_expression node.
 */
static BehTyp Tra_sum_exp (s)
     TNODE* s;
{
  switch ( Look_type(Look_son(s)) )
    { case tidentifier_declarations:
	return Tra_sum_val(s) ;
      case tgate_declarations:
	return Tra_sum_puer(s) ;
      default: Error("Tra_sum_exp");
      }
  return NULL;
}

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

/* Tra_par_exp
 * Tranlates the _par_expression "pe".
 */
static BehTyp  Tra_par_exp (pe)
     TNODE* pe ;
{
  BehTyp p;
  TNODE* aux;

  p = MakeB(0,ParC);
  aux = Look_son(pe);
  PutA(p,MakeA((AttrValueTyp)Tra_gat_dec_list(aux),GDLA));
  aux = Look_brother(aux);
  AddArgB(p,Tra_Beh(Look_brother(aux)));
  switch ( Look_rule(aux) )
    { case _parallel_operator_1:  /* full sincronizacion */
	PutNameB(p,FULL_SYNC);
	/* PutA(p,MakeA(GetGates(p),GSA)); */
	break;
      case _parallel_operator_2:  /* interleaving */
	PutNameB(p,INTER_SYNC);
	break;
      case _parallel_operator_3:  /* con puertas */
	PutNameB(p,PART_SYNC);
	PutA(p,MakeA((AttrValueTyp)Tra_gat_set(Look_son(aux)),GSA));
	break;
      }
  return p;
}

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

/* Tra_Beh
 * Translate the behaviour pointed by b.
 */
static BehTyp Tra_Beh (b)
     TNODE* b ;
{
  switch ( Look_type(b) )
    { case tlocal_definition_expression:
	return  Tra_loc_def_exp(b) ;
      case tsum_expression:
	return  Tra_sum_exp(b) ;
      case tpar_expression:
	return  Tra_par_exp(b) ;
      case thiding_expression:
	return  Tra_hid_exp(b) ;
      case tenable_expression:
	return  Tra_ena_exp(b) ;
      case tdisable_expression:
	return  Tra_dis_exp(b) ;
      case tparallel_expression:
	return  Tra_paral_exp(b) ;
      case tchoice_expression:
	return  Tra_cho_exp(b) ;
      case tguarded_expression:
	return  Tra_gua_exp(b) ;
      case taction_prefix_expression:
	return  Tra_act_pre_exp(b) ;
      case tatomic_expression:
	return  Tra_ato_exp(b) ;
      case tprocess_instantiation:
	return  Tra_pro_inst(b) ;
      default: Error("Tra_Beh: unexpected cell.");
      }
  return NULL;
}

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

/* Tra_val_par_list
 * Translates a value parameter list.
 * vpl points to a _value_parameter_list node.
 */
static ExprListTyp Tra_val_par_list(vpl)
     TNODE* vpl ;
{
  LASSERT(Look_type(vpl)==tvalue_parameter_list);
  return Tra_val_iddecls(Look_son(vpl));
}

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

/* Tra_gat_par_list
 * Translates The _gate_parameter_list pointed by gpl
 * into a GateListTyp.
 */
static GateListTyp Tra_gat_par_list(gpl)
     TNODE* gpl ;
{
  LASSERT(Look_type(gpl)==tgate_parameter_list);
  return Tra_gat_list(Look_son(gpl));
}

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

/* Tra_funclity
 * Translates the functionality.
 */
static void Tra_funclity( fl,p )
     TNODE* fl;
     BehTyp p;
{
  TNODE* sl;
  SortListTyp l;

  if (Look_rule(fl)==_functionality_list_1) {
    sl = Look_son(fl);
    if (sl!=NULL) {
      l = Create_list();
      for (sl=Look_son(sl) ; sl!=NULL ; sl=Look_brother(sl))
	l = Add_list((DataListTyp)Desref_To_nd(Look_idref(sl)),l);
      PutP_func(LookNameB(p),Store_func(l));
    }
    else
      PutP_func(LookNameB(p),EXITF);
  }
  else
    PutP_func(LookNameB(p),NOEXITF);
}

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

/* Tra_for_par_list
 * Translates the _formal_parameter_list "fpl" and
 * adds it to the cell "c".
 */
static void  Tra_for_par_list (fpl,c)
     TNODE* fpl ;
     BehTyp c;
{
  TNODE *pgpl, *pvpl;

  LASSERT(Look_type(fpl)==tformal_parameter_list);
  switch (Look_class(fpl))
    { case 4:  /* solo la funcionalidad */
	Tra_funclity(Look_son(fpl),c);
	break;
      case 5:  /* _gate_parameter_list */
	pgpl =  Look_son(fpl);
	PutA(c,MakeA((AttrValueTyp)Tra_gat_par_list(pgpl),GLA));
	Tra_funclity(Look_brother(pgpl),c);
	break;
      case 6:  /* _value_parameter_list */
	pvpl =  Look_son(fpl);
	PutA(c,MakeA((AttrValueTyp)Tra_val_par_list(pvpl),ELA));
	Tra_funclity(Look_brother(pvpl),c);
	break;
      case 7:  /* _gate_parameter_list  _value_parameter_list */
	pgpl =  Look_son(fpl);
	pvpl =  Look_brother(pgpl);
	PutA(c,MakeA((AttrValueTyp)Tra_gat_par_list(pgpl),GLA));
	PutA(c,MakeA((AttrValueTyp)Tra_val_par_list(pvpl),ELA));
	Tra_funclity(Look_brother(pvpl),c);
	break;
      default : Error("Tra_for_par_list: unexpected class.");
      }
}

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

static void Tra_def_procs ();

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

/* Tra_process
 * translate the tprocess_definition "p".
 */
static void Tra_process (p)
     TNODE* p ;
{
  BehTyp proc;
  char * nproc;
  DescriptorTyp ndp;

  LASSERT(Look_type(p)==tprocess_definition);
  p = Look_son(p);
  nproc = Look_lexv(p);
  ndp = Desref_To_nd(Look_iddec(p));
  if (ndp==0)
    ndp = Declare_MProc( nproc, (BehTyp)NULL, NOTCALCULATEDF, Look_iddec(p) );
  proc = MakeB(ndp,ProcessDefC);
  p = Look_brother(p);
  Tra_for_par_list(p,proc);
  p = Look_son(Look_brother(p));
  AddArgB(proc,Tra_Beh(p));
  PutP_def(ndp,proc);
  while (Exist_brother(p))
    p = Look_brother(p);
  if (Look_type(p)==tlocal_definitions)
    Tra_def_procs(p);
}

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

/* Tra_def_procs
 * Translate the processes defined in the specification.
 * "p" points to a _local_definitions node.
 */
static void Tra_def_procs (p)
     TNODE* p ;
{
  for ( p = Look_son(p) ; p!=NULL ; p = Look_brother(p) )
    Tra_process(p);
}

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

/* Tra_spec
 * Translates the specification.
 */
static BehTyp Tra_spec (t)
     TNODE* t ;
{
  BehTyp spc;
  TNODE* pbeh;
  char * nspc;
  DescriptorTyp d;

  LASSERT(Look_type(t)==tspecification);
  nspc = Look_lexv(Look_son(t));
  pbeh = Look_brother(Look_brother(Look_brother(Look_son(t))));
  if (Look_type(pbeh)==tdefinition_block)
    pbeh = Look_son(pbeh);
  else
    pbeh = Look_son(Look_brother(pbeh));
  d = Declare_MProc( nspc, (BehTyp)NULL,NOTCALCULATEDF, Look_iddec(Look_son(t)) );
  spc = MakeB(d,SpecificationC);
  Tra_for_par_list(Look_brother(Look_son(t)),spc);
  AddArgB(spc,Tra_Beh(pbeh));
  PutP_def(d,spc);
  if (Exist_brother(pbeh))
    Tra_def_procs(Look_brother(pbeh));
  return spc;
}

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

/* LoadSpec
 * Loads a file with a EPS LOTOS specification .
 * name is the name of the EPS spec_file.
 */
BehTyp  LoadSpec (name)
     char * name;
{
  TNODE *pelprado, *pgtd;
  BehTyp ptree;

  Init_map_tab();
  pelprado =  Look_root(name);
  if (pelprado != NULL) {
    if (Look_type(pelprado)!=tspecification)
      Error("Input file must contain a LOTOS specification, not a library.");
    pgtd = Look_son(pelprado);
    while (Look_type(pgtd)!=tdata_type_definitions)
      pgtd = Look_brother(pgtd);
    LoadTypes(pgtd);
    ptree =  Tra_spec(pelprado);
  }
  else
    ptree = NULL;
  Free_map_tab ();
  Free_astroot ();

  return ptree;
}

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

/* InitTR
 * Initiation of TR module.
 * This function must be called only when lola is invoked.
 */
void InitTR()
{
  cast_init(iocolours);
}

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