/**************************************************************
 *       ifldi.c - LBM Data Interpreter Interfaz
 **************************************************************/
/***********************************************
 (C) Copyright 1993-1994; dit/upm
   Distributed under the conditions stated in the
   TOPO General Public License (see file LICENSE)
 ***********************************************
 $Log: ifldi.c,v $
 * Revision 1.1  1994/10/17  16:40:49  lotos
 * Initial revision
 *
 **********************************************
 $Id: ifldi.c,v 1.1 1994/10/17 16:40:49 lotos Exp $
 **********************************************/

#include "swbus.h"

/* It generates an unique identifier for
 * a variable from its unique id and the
 * unique id of the process instance.
 */
PUBLIC char*
unique_var_id (S, vid, pid)
  spe S;
  int vid, pid;
{
  char *s;

  s = emalloc (strlen (l2s (S, vid)) + 100);

  (void)sprintf (s, "%s_%d_%d_%d", l2s (S, vid), vid, pid, S->code);
  return s;
}

/* It generates an unique EXTERNAL identifier for
 * a variable from its unique id and the
 * unique id of the process instance.
 */
PUBLIC char*
ext_unique_var_id (S, vid, pid)
  spe S;
  int vid, pid;
{
  char *s;

  s = emalloc (strlen (l2s (S, vid)) + 100);

  (void)sprintf (s, "%s_%d_%d", l2s (S, vid), vid, pid);
  return s;
}

PRIVATE klink
create_sons (S, pi, r)
  spe   S;
  int   pi;
  TNODE *r;
{
  if (gt_rb (r) == NULL)
    return lnsnode (val_exp2kdatum (S, pi, r), (klink)NULL, FALSE);
  return lnsnode (val_exp2kdatum (S, pi, r),
		  create_sons (S, pi, gt_rb (r)), TRUE);
}

/* Converts a _val_exp into a kdatum
 *   _value_exp ::=   [ _value_exp * ]
 */
PUBLIC kdatum
val_exp2kdatum (S, pi, r)
  spe   S;
  int   pi;
  TNODE *r;
{
  int    id, idui, sort, ldiui;
  char   *vname;
  klink  sons = NULL;
  kdatum val;

  assert (r != NULL);

  id = (int)takeclr (c_idref, r);
  idui = id2ui (S, (CLR_TYPE)id);
  sort = id2uisort (S, (CLR_TYPE)id);

  if (idclass (S, id) == TOPN)    /* An operation */
    if (IsInfix (r))
      val = mkinfix (mknode (idui),
		     val_exp2kdatum (S, pi, gt_fs (r)),
		     val_exp2kdatum (S, pi, gt_rb (gt_fs (r))));
    else {
      if (gt_fs (r) != NULL)
	sons = create_sons (S, pi, gt_fs (r));
      val = mkprefix (mknode (idui), sons, FALSE);
    }
  else {                          /* A variable */
    vname = unique_var_id (S, id, pi);
    if ((ldiui = get_var_id (vname, sort)) >= 0)
      fatal_error ("Cannot find variable", __FILE__, __LINE__);
    free (vname);
    val = mknode (ldiui);
  }
  return val;
}

PUBLIC int
Var_Declaration (S, varid, pi)
  spe S;
  int varid, pi;
{
  int  vid, vextid;
  char *vname, *vextname;

  assert (S != NULL);
  assert (S->code >= 0);
  assert (varid > 0);
  assert (pi >= 0);

  vname = unique_var_id (S, varid, pi);
  vextname = ext_unique_var_id (S, varid, pi);

  vid = dec_var (vname, id2uisort (S, (CLR_TYPE)varid));
  if ((vextid = get_var_id (vextname, id2uisort (S, (CLR_TYPE)varid))) >= 0)
    vextid = dec_var (vextname, id2uisort (S, (CLR_TYPE)varid));

  lnk (vid, vextid);
  free (vname);
  if (vid == NOVAR)
    fatal_error ("Cannot declare variable", __FILE__, __LINE__);
  return vid;
}

/* It declares the variables of a _BUT_definition,
 * taking them from the c_var_list color
 * "pi" is the process instance identifier
 * and initializes them taking values from argv
 */
PUBLIC void
BUT_definition_parameters (S, kt, argc, argv, r)
  spe    S;
  krnlt  kt;
  int    argc;
  kdatum *argv;
  TNODE  *r;
{
  TATTR   *aux;
  INTlist varl;
  int     i, vid;

  assert (r != NULL);
  assert (r->type == tBUT_definition);
  assert (argc != 0);
  assert (argv != NULL);

  aux = find_attr (c_var_list, r);
  if (aux == NULL)
    fatal_error ("Parameter definition expected", __FILE__, __LINE__);

  varl = (INTlist)aux->value;
  assert (varl != NULL);

  if (argc != INTlength (varl))
    fatal_error ("Wrong number of parameters", __FILE__, __LINE__);

  if (kt->env == NULL)
    kt->env = I2Tcreate (INTlength (varl), 1, 1);

  for (i=0; varl != NULL; i++, varl = INTtail (varl)) {
    vid = Var_Declaration (S, INThead (varl), kt->pi);
    (void)I2Tadd (INThead (varl), vid, kt->env);
    if (!let_var (vid, kd_rw_node (argv[i])))
      fatal_error ("Cannot initialize variable", __FILE__, __LINE__);
  }
}

/* It declares and initialices the variables
 * of a _let_exp. Remembering the nodes:
 * _let_exp ::= _ident_equation_list
                state
                [_annotation_list]
 * _ident_equation_list ::= [ _ident_quation + ]
 * _ident_equation ::= _value_exp
         $0.var_list
 * taking them from the c_var_list color
 * "pi" is the process instance identifier
 */
PUBLIC void
let_exp_dec_vars (S, kt, pi, r)
  spe   S;
  krnlt kt;
  int   pi;
  TNODE *r;
{
  kdatum  value;
  INTlist varl;
  int     vid;

  assert (r->type == tident_equation_list);

  if (kt->env == NULL)
    kt->env = I2Tcreate (10, 1, 1);

  for (r = gt_fs (r); r != NULL; r = gt_rb (r)) {
    value = kd_rw_node (val_exp2kdatum (S, pi, gt_fs (r)));
    for (varl = (INTlist)takeclr (c_var_list, r);
	 varl != NULL;
	 varl = INTtail (varl)) {
      vid = Var_Declaration (S, INThead (varl), pi);
      if (!let_var (vid, kd_copy (value)))
	fatal_error ("Cannot initialize variable", __FILE__, __LINE__);
      (void)I2Tadd (INThead (varl), vid, kt->env);
    }
    kd_free (value);
    value = NULL;
  }
}

/* It declares the variables of a _experiment_list.
 * Remembering the nodes:
 * _experiment_list ::= [ _experiment + ]
 * experiment ::= _var_id  <<-- This declared a variable!
 * experiment ::= _value_exp
 * taking them from the c_var_id color
 * "pi" is the process instance identifier
 */
PUBLIC void
ext_off_dec_vars (S, kt, pi, r)
  spe   S;
  krnlt kt;
  int   pi;
  TNODE *r;
{
  int varid, vid;

  assert (r->type == texperiment_list);

  if (kt->env == NULL)
    kt->env = I2Tcreate (10, 1, 1);

  for (r = gt_fs (r); r != NULL; r = gt_rb (r))
    if (r->type == tvar_id) {
      varid = (int)takeclr (c_var_id, r);
      vid = Var_Declaration (S, varid, pi);
      (void)I2Tadd (varid, vid, kt->env);
    }
}

/* It declares the variables of a _var_choice_exp.
 * Remembering the nodes:
 * _var_domain_list ::= [ _var_id + ]
 * _var_id ::= [ _annotation_list ]
        $0_var_id.var_id  INTEGER
 * taking them from the c_var_id color
 * "pi" is the process instance identifier
 */

PUBLIC void
choice_exp_dec_vars (S, kt, pi, r)
  spe   S;
  krnlt kt;
  int   pi;
  TNODE *r;
{
  int varid, vid;

  assert (r->type == tvar_domain_list);

  if (kt->env == NULL)
    kt->env = I2Tcreate (10, 1, 1);

  for (r = gt_fs (r); r != NULL; r = gt_rb (r)) {
    varid = (int)takeclr (c_var_id, r);
    vid = Var_Declaration (S, varid, pi);
    (void)I2Tadd (varid, vid, kt->env);
  }
}

/* It declares and initialices the variables
 * of a _enable_exp. Remembering the nodes:
 * _enable_exp ::= state
                   state
                   [ _annotation_list ]
       $0_enable_exp.var_list  INTlist
 * taking them from the c_var_list color
 * "pi" is the process instance identifier
 */
PUBLIC void
enable_exp_dec_vars (S, kt, pi, r)
  spe   S;
  krnlt kt;
  int   pi;
  TNODE *r;
{
  TATTR   *aux;
  INTlist varl;
  int     vid;

  assert (r != NULL);
  assert (r->type == tenable_exp);

  if ((aux = find_attr (c_var_list, r)) != NULL) {
    varl = (INTlist)aux->value;

    if (INTlength (varl) > 0) {
      if (kt->env == NULL)
	kt->env = I2Tcreate (INTlength (varl), 1, 1);
      for ( ; varl != NULL; varl = INTtail (varl)) {
	vid = Var_Declaration (S, INThead (varl), pi);
	(void)I2Tadd (INThead (varl), vid, kt->env);
      }
    }
  }
}
