/**************************************************************
 *       info.c - LBM Interpreter Information
 **************************************************************/
/***********************************************
 (C) Copyright 1993-1994; dit/upm
   Distributed under the conditions stated in the
   TOPO General Public License (see file LICENSE)
 ***********************************************
 $Log: info.c,v $
 * Revision 1.3  1994/10/17  16:40:55  lotos
 * cosmetics.
 *
 * Revision 1.2  1993/12/22  17:20:39  lotos
 * Changed a number of names in the interface
 * Added function  to work with instances of processes and their gates
 * CLOSING BASIC LOTOS VERSION OF LIBRARY!
 *
 * Revision 1.1  1993/10/16  10:53:54  lotos
 * Initial revision
 *
 **********************************************
 $Id: info.c,v 1.3 1994/10/17 16:40:55 lotos Exp $
 **********************************************/

#include "swbus.h"

PRIVATE TNODE*
search_hie (p, r)
  proc   p;
  TNODE *r;
{
  TNODE *aux, *auxson = NULL;

  if (r == NULL)
    return NULL; /* not found */
  if ((int)takeclr (c_proc, r) == p) /* found !*/
    return r;
  for (aux = gt_fs (r); aux != NULL; aux = gt_rb (aux))
    if ((auxson = search_hie (p, aux)) != NULL)
      return auxson;
  return NULL;
}

PUBLIC char*
sortname (S, srt)
  spe  S;
  Sort srt;
{
  assert (S != NULL);

  return l2s (S, srt);
}

PUBLIC char*
gatename (S, g)
  spe S;
  Gte g;
{
  assert (S != NULL);

  switch (g) {
  case LNOGATE :
    fatal_error ("Unkown gate in offert", __FILE__, __LINE__);
    break;
  case LEXITG :
    return "EXIT";
  case LINTERG :
    return "i";
    default :
      return l2s (S, g);
  }
  fatal_error ("How I get this point?", __FILE__, __LINE__);
  return ""; /* To shut lint off */
}

PUBLIC Gte
offertgate (S, of)
  spe    S;
  offert of;
{
  soffert *aux;

  aux = search_soffert (S, of);

  return aux->g;
}

PUBLIC char*
offertname (S, of)
  spe    S;
  offert of;
{
  return gatename (S, offertgate (S, of));
}

PUBLIC gtelist
get_gates (S, of)
  spe    S;
  offert of;
{
  INTlist ktl;
  gtelist gl = NULL;
  soffert *aux;

  aux = search_soffert (S, of);

  for (ktl = aux->ktl; ktl != NULL; ktl = INTtail (ktl))
    gl = INTcons (search_kt (INThead (ktl), S->kt)->g, gl);
  return gl;
}

PUBLIC proclist
get_proc_insts (S, of)
  spe    S;
  offert of;
{
  INTlist  ktl;
  proclist pl = NULL;
  soffert  *aux;

  aux = search_soffert (S, of);

  for (ktl = aux->ktl; ktl != NULL; ktl = INTtail (ktl))
    pl = INTcons (search_kt (INThead (ktl), S->kt)->pi, pl);
  return pl;
}

PUBLIC char*
procinstname (S, pi)
  spe  S;
  proc pi;
{
  krnlt kt = NULL;
  TNODE *r  = NULL;

  assert (S != NULL);

  if ((kt = search_pi_kt (pi, S->kt)) != NULL)
    return l2s (S, kt->BUT);
  if (S->doph)
    if ((r = search_hie (pi, S->ph)) != NULL)
      return (char*)takeclr (c_procname, r);
  return NULL;
}

PUBLIC proc
proc_by_gate (S, of, gid)
  spe    S;
  offert of;
  Gte    gid;
{
  soffert *aux;
  INTlist ktl;
  krnlt   kt;

  aux = search_soffert (S, of);

  for (ktl = aux->ktl; ktl != NULL; ktl = INTtail (ktl)) {
    kt = search_kt (INThead (ktl), S->kt);
    if (kt->g == gid)
      return kt->uid;
  }
  return -1;
}

PUBLIC char*
specname (S)
  spe S;
{
  assert (S != NULL);

  return strdup (S->name);
}

PUBLIC Gte
gate_by_level (S, goalpi, origpi, g)
  spe  S;
  proc goalpi, origpi;
  Gte  g;
{
  Gte   searched;
  int   pos;
  krnlt kt;

  searched = g;
  for (kt = search_pi_kt (origpi, S->kt);
       (kt != NULL);
       kt = kt->fth) {
    if (kt->class == LHIDE)
      if (INTIsIn (searched, kt->gtes))
	return LINTERG;
    if (kt->rlb != NULL)
      if ((pos = INTpos (searched, kt->rlb->formal)) != 0)
	searched = INTnth (pos, kt->rlb->actual);
    if (kt->pi == goalpi)
      return searched;
  }
  return LNOGATE;
}

PUBLIC int
NumExp (S, of)
  spe    S;
  offert of;
{
  soffert *soff;

  soff = search_soffert (S, of);

  return soff->nexp;
}

PUBLIC Sort
SortExp (S, of, ne)
  spe    S;
  offert of;
  int    ne;
{
  soffert *soff;

  soff = search_soffert (S, of);

  if ((ne < 1) || (ne > soff->nexp))
    return NOSORT; /* error */

  return soff->expl[ne-1]->sort; /* experiments are numbered from 1 to n */
}

PUBLIC int
TypeExp (S, of, ne)
  spe    S;
  offert of;
  int    ne;
{
  soffert *soff;

  soff = search_soffert (S, of);

  if ((ne < 1) || (ne > soff->nexp))
    return NOTYPE; /* error */

  return soff->expl[ne-1]->type; /* experiments are numbered from 1 to n */
}

PUBLIC kdatum
ValueExp (S, of, ne, rewrite)
  spe     S;
  offert  of;
  int     ne;
  boolean rewrite;
{
  soffert *soff;
  kdatum  res;
  varlist setvl = NULL;

  soff = search_soffert (S, of);

  if ((ne < 1) || (ne > soff->nexp))
    return NULL; /* error */

  if (rewrite)
    setvl = rewrite_soffert (soff);

  /* experiments are numbered from 1 to n */
  res = kd_rw_node (kd_copy (soff->expl[ne-1]->val));

  if (rewrite)
    unrewrite_soffert (setvl);

  return res;
}

PUBLIC varlist
get_VarlistExp (S, of, ne)
  spe    S;
  offert of;
  int    ne;
{
  soffert *soff;

  soff = search_soffert (S, of);

  if ((ne < 1) || (ne > soff->nexp))
    return NULL; /* error */

  /* experiments are numbered from 1 to n */
  return INTdup (soff->expl[ne-1]->vrlst);
}

PUBLIC CNDlist
get_GRDlist (S, of)
  spe S;
  offert of;
{
  INTlist  ktl;
  krnlt    *ktarray;
  int      idx, ktmax;
  CNDlist  cl = NULL;
  soffert *soffer;

  soffer = search_soffert (S, of);

  /* Searching states, to avoid repetitions */
  /* Building an array which contains all the leaves */
  ktmax = INTlength (soffer->ktl);
  assert (ktmax > 0);
  ktarray = (krnlt*)emalloc (ktmax * sizeof (krnlt));
  for (idx = 0, ktl = soffer->ktl;
       ktl != NULL;
       idx++, ktl = INTtail (ktl))
    ktarray[idx] = search_kt (INThead (ktl), S->kt);

  for (idx = 0; idx < ktmax; idx++)
    cl = CNDappend (search_grd_kt (ktarray[idx]), cl);

  return cl;
}

PUBLIC int
NumPRD (S, of)
  spe    S;
  offert of;
{
  soffert *soff;

  soff = search_soffert (S, of);

  /* predicates are numbered from 1 to n */
  return CNDlen (soff->prdl);
}

PUBLIC CNDlist
get_PRDlist (S, of)
  spe    S;
  offert of;
{
  soffert *soff;

  soff = search_soffert (S, of);

  return CNDcopy (soff->prdl);
}

PUBLIC int
chk_cond (cnd)
  cond cnd;
{
  return ldiequal (kd_copy (cnd->val1), kd_copy (cnd->val2));
}

#ifdef lint

/* ARGSUSED */
PUBLIC offert
first_off (offs)
  set_off offs;
{ return 0; }

/* ARGSUSED */
PUBLIC offert
getnoff (n, offs)
  int n;
  set_off offs;
{ return 0; }

/* ARGSUSED */
PUBLIC set_off
rest_set_off (offs)
  set_off offs;
{ return NULL; }

/* ARGSUSED */
PUBLIC int
card_set_off (offs)
  set_off offs;
{ return NULL; }

/* ARGSUSED */
PUBLIC void
free_set_off (offs)
  set_off offs;
{}

/* ARGSUSED */
PUBLIC boolean
NOTCNDIsIn (cnd, cl)
  cond    cnd;
  CNDlist cl;
{ return TRUE; }

/* ARGSUSED */
PUBLIC char*
varname (v)
  Var v;
{ return NULL; }

#endif
