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

/***********************************
  
  Maria Hultstrom
  
  10-9-1990
  
  Removes unused variables in the specification, the process definitions and 
  the process instantiations.
  
  COMPILATION OPTIONS: The behaviour of this module can be modified
  by the following compilation flags:
  
  (none)
  
  ************************************/ 

/* KJT 12/02/12: Added */
#include <stdlib.h>
#include "listdh.h"
#include "babeh.h"
#include "badefca.h"
#include "batables.h"
#include "lilists.h"
#include "baexpr.h"
#include "exrmparm.h"
#include "baattr.h"
#include "licell.h"
#include "limisc.h"
#include "listdout.h"


/******************************************************************
 *
 *  Data structures to maintain the dependencies between processes.
 *
 *******************************************************************/

typedef struct twolist { DescriptorTyp       name;
                         ListTyp             numlist;
                         struct twolist *    next;
                       } TwoList, *PTwoList;

/* Declares two global struct's:  VisitProc -  contains all processes delt 
 * with and a list with the order of the parameters used in the behaviour,
 * DependProc - contains all processes which depend on other proceses and for 
 * each process a list of its dependence and the parameters used therein.
 */
PTwoList DependProc, VisitProc;

/* Declares a global list which contains all process instantiations */
static ListTyp ProcInst;

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

/* NewTwoList
 * Allocates memory for twolist
 */
static PTwoList NewTwoList()
{
  PTwoList p;
  
  p          = (PTwoList) emalloc(sizeof(TwoList));
  p->numlist = NULL;
  p->next    = NULL;
  return p;
}

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

/* FreeTwoList
 * Frees the memory of a twolist. dep is a predicate that indicates if the 
 * numlist points two a list with numbers or a list which contains a list 
 * of numbers.
 */
static void FreeTwoList ( p, dep )
     PTwoList p;
     boolean dep;
{
  PTwoList q;
  
  for ( ; p != NULL; p = q ) {
    q = p->next;
    if ( dep )
      Free_list( p->numlist, Disp_list );
    else 
      Disp_list( p->numlist );
    free( (char *) p);
  } 
}

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

/* FreeDepList
 * Frees memory for DependProc whose numlist points two a struct twolist
 */
static void FreeDepList(l)
     PTwoList l;
{
  PTwoList tmp;
  
  for ( tmp = l; tmp != NULL; tmp= tmp->next ) {
    FreeTwoList( (PTwoList) tmp->numlist, TRUE );
    tmp->numlist = NULL;
  }
  FreeTwoList( l, FALSE );
}

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

/* DeleteNode
 * Deletes the node n in the twolist l (DependProc) and returns the new list.
 */
static PTwoList DeleteNode( n, l )
     PTwoList n, l;
{
  PTwoList tmp;
  
  if ( n == l ) 
    l = l->next;
  else {
    for ( tmp = l; tmp->next != n ; tmp = tmp->next ) ;
    tmp->next = n->next;
  }
  n->next = NULL;
  FreeDepList( n );
  return( l );
}

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

/* InTwoList
 * Returns a pointer to a node in tl whose element is equal to name,
 * or NULL if name is not in tl.
 */
static PTwoList InTwoList( name, tl )
     DescriptorTyp name;
     PTwoList tl;
{
  while (tl != NULL) {
    if (tl->name == name)
      return tl;
    tl = tl->next;
  }
  return NULL;
}

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

/* IdE
 * Identity function for expressions.
 */
static ExprTyp IdE( e )
     AttrValueTyp e;
{
  return (ExprTyp) e;
} 

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

/* Next2_list
 * Returns next argument
 */
static AttrValueTyp Next2_list (e)
     ListTyp e;
{
  return ( (AttrValueTyp) Next_list( (ListTyp) e) );
}

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

/* LookE
 * 
 */
static AttrValueTyp LookE ( b, type )
     BehTyp b;
     int type;
{
  return( LookAInfo( LookA(b,type ) ) );
}

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

/* CreateVarList
 * Inserts all variables in the expression e into the list vlist.
 */ 
static void CreateVarList (vlist, e)
     ListTyp *vlist;
     ExprTyp e;
{
  ExprTyp a;
  int n,i;
  
  if ( e != NULL ) {
    if ( LookTypeE(e) == VariableC ) {
      if ( ! In_list((DataListTyp)LookNameE(e), *vlist, EqInt) )
        *vlist = Insert_list( (DataListTyp)LookNameE(e), *vlist );
    } 
    else {
      n = NumArgE(e);
      for (i=1 ; i<=n ; i++) {
	a = LookArgE(e,i);
        CreateVarList( vlist, a );
      }
    }
  }
}

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

/* Order
 * Returns a list of numbers, where the number n means that the n:th 
 * parameter  in arg2 has been used in arg1.
 */
static ListTyp Order( arg1, arg2 )
     ExprListTyp arg2;
     ListTyp arg1;
{
  ListTyp num;
  int i;
  
  num = Create_list();
  if (arg1 != NULL) {
    for  (i = 1 ; arg2 != NULL; arg2 = Next_list(arg2) ) {
      if ( In_list((DataListTyp)LookNameE((ExprTyp)LookInfo_list(arg2)),
		   arg1, EqInt) )
        num = Insert_list( (DataListTyp) i, num );
      ++i;
    }
  }
  return num;
}

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

/* ParOrder
 * Returns a list containing for each element in arg1 a list of the variables 
 * order in arg2.
 */
static ListTyp ParOrder ( arg1, arg2 )
     ExprListTyp arg1, arg2;
{
  ListTyp num;
  ListTyp lv;
  
  num = Create_list();
  for ( ; arg1 != NULL; arg1 = Next_list(arg1) ) {
    lv = Create_list();
    CreateVarList( &lv, (ExprTyp) LookInfo_list(arg1) );
    num = Add_list( (DataListTyp) Order(lv,arg2), num );
    Disp_list(lv);
  }
  return num;
}

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

/* UsedP         
 * Returns a list of the order of arg1's variables in arg2.
 */
static ListTyp UsedP( arg1, arg2, GetExp, Next )
     AttrValueTyp arg1, (*Next)();
     ExprListTyp  arg2;
     ExprTyp (*GetExp)();
{
  ListTyp lv;
  ListTyp num;
  
  lv = Create_list();
  for ( ; arg1 != NULL; arg1 = (*Next)(arg1) )
    CreateVarList( &lv, (*GetExp)(arg1) );
  num = Order( lv, arg2 );
  Disp_list(lv);
  return num;
}

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

/* Union
 * Returns the union of arg1, arg2. Uses the memory allocated and frees
 * the memory not needed.
 */
static ListTyp Union( arg1, arg2 )
     ListTyp arg1, arg2;
{
  ListTyp tmp, tmp1;
  
  tmp = arg1;
  while ( tmp != NULL ) {
    tmp1 = Next_list(tmp);
    if ( In_list( LookInfo_list(tmp), arg2, EqInt) )
      arg1 = DeleteNode_list( tmp, arg1 ); 
    tmp = tmp1;
  }          
  return( Join_list(arg2, arg1) );
} 

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

/* ParUnion
 * Returns the union of arg1, arg2. 
 * Arg1 and arg2 are lists of list of integers.
 * Uses the memory allocated and frees the memory not needed.
 */
static ListTyp ParUnion( arg1, arg2 )
     ListTyp arg1, arg2;
{
  ListTyp i, j;
  
  LASSERT(Length_list(arg1)==Length_list(arg2));
  i = arg1;
  j = arg2;
  while (i!=NULL) {
    PutInfo_list(i,(DataListTyp)Union((ListTyp)GetInfo_list(i),
				      (ListTyp)GetInfo_list(j)));
    i = Next_list(i);
    j = Next_list(j);
  }
  Disp_list(arg2);
  return arg1;
} 

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

/* LookExpr_in_EL
 * Returns the expression of an ExprList node.
 */
static ExprTyp LookExpr_in_EL(el)
     ExprListTyp el;
{
  return (ExprTyp)LookInfo_list(el);
}

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


/* LookEXCL
 * Returns the expression of an offerlist if type is EXCLAMATION, else NULL.
 */
static ExprTyp LookEXCL( ol )
     OfferListTyp ol;
{
  if ( LookKindOffer(ol) == EXCLAMATION )
    return LookExprOffer(ol);
  else
    return NULL;
}  

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

static ExprTyp LookP(p)
     PredicateTyp p;
{
  return LookRwPred(p);
}

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

/* 
 * Removes b's arguments whose order is not included in the num-list.
 */
static void Remove ( b, num_list )
     BehTyp  b;
     ListTyp num_list;
{
  PAttrTyp attr;
  ExprListTyp tmp, tmp1, explist;
  ExprTyp e;
  int i = 1;
  
  UnshareA( b, ELA );
  attr = GetA( b, ELA );
  if ( attr != NULL ) {
    explist = (ExprListTyp) GetAInfo(attr); 
    tmp     = explist;
    while ( tmp != NULL ) {
      tmp1 = Next_list(tmp);
      if ( ! In_list( (DataListTyp) i, num_list, EqInt) ) {  
        e = (ExprTyp) GetInfo_list(tmp);
        if ( e != NULL ) {
          e = UnshareE(e);
          FreeE( e );
	}
        explist = DeleteNode_list( tmp, explist );
      }
      ++i;
      tmp = tmp1;
    }
    if ( explist != NULL ) {
      PutAInfo( attr, (AttrValueTyp) explist );
      PutA( b, attr );
    }
    else
      FreeA( attr );  
  }
}

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

/* LookPar
 * Looks for parameters in b and includes information in DependProc, VisitProc 
 * and ProcInst. el contains the parameters of the specification or the
 * process whose behaviour are being searched. vp and dep points to the process
 * node in VisitProc and DependProc respectively.
 * "fp" is the DescriptorTyp of the first process definition explored to
 * remove its parameters.
 */
static void LookPar( b, el, vp, dep, fp )
     BehTyp b;
     ExprListTyp  el;
     PTwoList dep, vp;
     DescriptorTyp fp;
{
  ListTyp num;
  int argnum, i;
  PTwoList dp,dep_proc;
  ExprListTyp piel;
  
  while (b!=NULL) {
    if ( VisitedB(b) )
      return;
    switch( LookTypeB(b) )
      { case ProcessInstC:   
	  if (LookNameB(b)>=fp) {
	    if ((piel=(ExprListTyp)LookE(b,ELA))!=NULL) {
	      if ( ! In_list( (DataListTyp) b, ProcInst, EqInt ) )
		ProcInst = Insert_list( (DataListTyp) b, ProcInst ); 
	      dep_proc = InTwoList(LookNameB(b),(PTwoList) dep->numlist);
	      if (dep_proc==NULL) {
		dp       = NewTwoList();
		dp->name = LookNameB(b);
		dp->next = (PTwoList) dep->numlist;  
		dp->numlist = ParOrder( piel, el );
		dep->numlist = (ListTyp) dp;
	      }
	      else {
		dep_proc->numlist = ParUnion(ParOrder(piel,el),
					     dep_proc->numlist);
	      }
	    }
	  }
	  else {
	    if (el != NULL) { 
	      num = UsedP( LookE(b,ELA),el,LookExpr_in_EL,Next2_list );
	      vp->numlist = Union( num, vp->numlist );  
	    }
	  }
	  return;
	  
	case GuardC:
	  if (el != NULL) { 
	    num = UsedP(LookE(b,PA),el,LookP,(AttrValueTyp (*)())VoidF);
	    vp->numlist = Union(num, vp->numlist);
	  }
	  b = LookArgB(b,1);
	  break;
	  
	case GateC:
	  if (el != NULL) { 
	    num = UsedP( LookE(b,OLA), el, LookEXCL,
			(AttrValueTyp (*)()) MvNextOffer );
	    vp->numlist = Union( num, vp->numlist );  
	    num         = UsedP( LookE(b,PA), el, LookP,
				(AttrValueTyp (*)())VoidF );
	    vp->numlist = Union( num, vp->numlist );
	  }
	  b = LookArgB( b, 1 );
	  break;
	  
	case ExitC:
	  if ( el != NULL ) { 
	    num         = UsedP( LookE(b,OLA), el, LookEXCL,
				(AttrValueTyp (*)()) MvNextOffer );
	    vp->numlist = Union( num, vp->numlist ); 
	  }   
	  return;
	  
	case PletC:
	  if ( el != NULL ) { 
	    num         = UsedP( LookE(b,VALA), el, LookExprVAL, Next2_list );
	    vp->numlist = Union( num, vp->numlist );
	  }   
	  return;           
	  
	case LetC: 
	  if (el != NULL) { 
	    num         = UsedP(LookE(b,VALA),el,LookExprVAL,Next2_list);
	    vp->numlist = Union(num, vp->numlist); 
	  }   
	  b = LookArgB(b,1);
	  break;
	  
	case StopC:
	case TerminationC: 
	  return;
	  
	case ChoiceC:
	case IC:
	case RelabellingC: 
	case HidingC: 
	case GateChoiceC: 
	case ParC: 
	  b = LookArgB(b,1);
	  break;
	  
	case AlternativeC:
	  argnum = NumArgB(b);
	  for ( i=2; i <= argnum; ++i ) 
	    LookPar(LookArgB(b,i), el, vp, dep, fp);
	  b = LookArgB(b,1);
	  break;
	  
	case EnablingC: 
	case DisablingC: 
	case ParallelC: 
	case InterleavedC: 
	  LookPar(LookArgB(b,2), el, vp, dep, fp);
	  b = LookArgB(b,1);
	  break;
	  
	default:
	  Error(" EXrmparam: unexpected cell.");
	}
  }
  return;
} 

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

/* SearchInst
 * Searchs all the process instantiations which name is greater or
 * equal to "fp". These instantiations are includes in ProcInst.
 * "b" is the behaviour that has been expanded. 
 * Note that it is neither a specification nor a process definition cell.
 */
static void SearchInst( b, fp )
     BehTyp b;
     DescriptorTyp fp;
{
  int argnum, i;
  DescriptorTyp b2;
  
  LASSERT( (LookTypeB(b)!=ProcessDefC) && (LookTypeB(b)!=SpecificationC) );
  
  
  if ( b != NULL )   
    if ( VisitedB(b) )
      return;
  switch( LookTypeB(b) )
    { case ProcessInstC:
	b2 = LookNameB(b);
	if (LookE(b,ELA)!=NULL)
	  if ( b2 >= fp )
	    if ( ! In_list( (DataListTyp) b, ProcInst, EqInt ) )
	      ProcInst = Insert_list( (DataListTyp) b, ProcInst );  
	break;
	
      default:
	argnum = NumArgB(b); 
	for ( i=1; i<=argnum; i++ )
	  SearchInst( LookArgB(b,i), fp );
      }
  return ;
}

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

/* Amplify
 * Amplifies the list of used parameters if necessary and returns 
 * true, else false. 
 */
static boolean Amplify ( arg1, arg2 )
     PTwoList arg1, arg2;
{
  PTwoList vp1, vp2;
  ListTyp tmp, tmp2;  
  int i = 1;
  boolean changes = FALSE;
  
  tmp2 = arg2->numlist;
  vp2  = InTwoList( arg2->name, VisitProc );
  vp1  = InTwoList( arg1->name, VisitProc );
  for ( ; tmp2 != NULL; tmp2 = Next_list(tmp2) ) {
    if ( In_list( (DataListTyp) i, vp2->numlist, EqInt) ) {
      if ( ! SubSet_list( (ListTyp) (tmp2->info), vp1->numlist, EqInt) ) {
	tmp = Copy_list( (ListTyp)(tmp2->info), (DataListTyp (*)())EchoInt ); 
	vp1->numlist = Union( tmp, vp1->numlist);
	changes = TRUE;
      }
    }
    ++i;
  }
  return(changes);
}

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

/* CheckMorePar
 * Checks for each process in DependProc if the list of used parameters in
 * VisitProc may be amplified. When no changes have been made in any of the
 * processes or when DependProc is NULL, frees what is left of DependProc.
 */
static void CheckMorePar()
{
  PTwoList tmp, tmp1, tmp2, d;
  boolean  ch, removable, changes;
  
  /* 
     Delete processes that do not call to any other process 
     (with parameters and with a name greater than firstproc)
     */
  tmp = DependProc;
  while ( tmp != NULL ) {
    tmp1 = tmp->next;
    if ( tmp->numlist == NULL )
      DependProc = DeleteNode( tmp, DependProc ); 
    tmp = tmp1;
  }
  
  tmp = DependProc;
  changes = TRUE;
  while ( tmp != NULL && changes ) {
    changes = FALSE;
    while ( tmp != NULL ) {
      tmp1      = tmp->next;
      removable = TRUE;
      tmp2      = (PTwoList) tmp->numlist;
      for ( ; tmp2 != NULL; tmp2 = tmp2->next ) {
	d = InTwoList( tmp2->name, DependProc );
	ch = Amplify( tmp, tmp2 );
	changes = changes || ch;
	if (d != NULL) 
	  removable = FALSE; 
      }
      if (removable) 
	DependProc = DeleteNode( tmp, DependProc ); 
      tmp = tmp1;
    }
    tmp = DependProc;
  }
  FreeDepList( DependProc ); 
}

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

/* RmProc
 * Removes unused parameters in the specification and the process definitions.
 */
static void RmProc ()
{
  PTwoList tmp;
  
  for ( tmp = VisitProc; tmp != NULL; tmp = tmp->next ) 
    Remove( GetP_def(tmp->name), tmp->numlist ); 
} 

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

/* RmPInst
 * Removes unused parameters in the process instantiations.
 */
static void RmPInst()
{
  ListTyp tmp;
  BehTyp b;
  PTwoList vp;
  
  for ( tmp = ProcInst; tmp != NULL; tmp = Next_list(tmp) ) {
    b = (BehTyp) LookInfo_list( tmp );
    vp = InTwoList( LookNameB(b), VisitProc );
    Remove( b, vp->numlist ); 
  }
} 

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

static void PrintVisitList()
{
  PTwoList tmp;
  ListTyp li;
  char buff[1024];
  
  printMsgs("\nVisitList\n");
  for ( tmp = VisitProc; tmp != NULL; tmp = tmp->next ) {
    (void)sprintf(buff," %d: ",tmp->name);
    printMsgs(buff);
    for ( li = tmp->numlist; li != NULL; li = li->next ) { 
      (void)sprintf(buff," %d ",LookInfo_list(li));
      printMsgs(buff);
    }
    printMsgs("\n");
  }
}

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

static void PrintDependList()
{
  PTwoList tmp,li;
  ListTyp ol,nl;
  int i;
  char buff[1024];
  
  printMsgs("\nDependList\n");
  
  for ( tmp = DependProc; tmp != NULL; tmp = tmp->next ) {
    (void)sprintf(buff,"Proceso %d->\n",tmp->name);
    printMsgs(buff);
    
    for ( li = (PTwoList)tmp->numlist; li != NULL; li = li->next ) { 
      (void) sprintf(buff," proc %d:\n",li->name);
      printMsgs(buff);
      for ( ol = li->numlist,i=1; ol != NULL; ol = ol->next,i++ ) { 
        (void) sprintf(buff,"    orden %d: ",i);
	printMsgs(buff);
	for ( nl = (ListTyp)LookInfo_list(ol) ; nl != NULL; nl = nl->next ) {
          (void) sprintf(buff,"%d ",LookInfo_list(nl));
	  printMsgs(buff);
	}
	printMsgs("\n");
      }
    }
    printMsgs("\n");
  }
}


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

/* RmParameters
 * Main process for removing unused parameters in the specification and 
 * the processes. Deals only with processes whose Descriptor is greater
 * than firstproc.
 */
void RmParameters( b, firstProc  )
     BehTyp b;
     DescriptorTyp firstProc;  
{ 
  int i;
  PTwoList t1, t2;
  ExprListTyp el;
  
  printMsgs("    Removing Parameters.\n\n");  
  VisitProc = DependProc = NULL; 
  ProcInst  = Create_list();
  
  Begin_VisitB();
  SearchInst( b, firstProc );
  End_VisitB();
  
  for (i=firstProc ; i<=LastTableP() ; i++ ) {
    b = GetP_def(i);
    el =  (ExprListTyp) LookE(b,ELA);
    if (el==NULL) {
      Begin_VisitB();
      SearchInst( LookArgB(b,1), firstProc );
      End_VisitB();
    }
    else {
      t1         = NewTwoList();  
      t1->name   = i; 
      t1->next   = VisitProc; 
      VisitProc  = t1; 
      t2         = NewTwoList();
      t2->name   = i;
      t2->next   = DependProc;
      DependProc = t2; 
      Begin_VisitB();
      LookPar( LookArgB(b,1), el, t1,t2, firstProc );
      End_VisitB();
    }
  }
  
  /*
     PrintVisitList();
     PrintDependList();
     */
  
  CheckMorePar();
  RmProc();
  RmPInst();
  FreeTwoList( VisitProc, FALSE ); 
  Disp_list (ProcInst );
  
}

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