/* Helpful set of Utilities for the main parser
   Copyright (C) 1992-2000 Michigan State University

   The CAPA system is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as
   published by the Free Software Foundation; either version 2 of the
   License, or (at your option) any later version.

   The CAPA system is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public
   License along with the CAPA system; see the file COPYING.  If not,
   write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA.

   As a special exception, you have permission to link this program
   with the TtH/TtM library and distribute executables, as long as you
   follow the requirements of the GNU GPL in regard to all of the
   software in the executable aside from TtH/TtM.
*/

/* =||>>================================================================<<||= */
/* 45678901234567890123456789012345678901234567890123456789012345678901234567 */
/* =||>>================================================================<<||= */
/*            capaGrammarDef.y    created by Isaac Tsai                       */
/*                                1998, 1999 by Isaac Tsai        */
/* ADDED:2/10/99  *FormulaTree_p to handle formula symbols                    */
/* ========================================================================== */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>  /* isupper() */

#define  YYSTYPE Symbol*
#include "capaCommon.h"
#include "capaParser.h"
#include "capaToken.h"
#include "ranlib.h"

#ifdef   PARSER_DBUG
#define  PPDBUG_PR1(xx)        { printf(xx);       fflush(stdout); }
#define  PPDBUG_PR2(xx,yy)     { printf(xx,yy);    fflush(stdout); }
#define  PPDBUG_PR3(xx,yy,zz)  { printf(xx,yy,zz); fflush(stdout); }
#else
#define  PPDBUG_PR1(xx)        { }
#define  PPDBUG_PR2(xx,yy)     { }
#define  PPDBUG_PR3(xx,yy,zz)  { }
#endif

#define       N_TYPE(N)        (((N)->t_sp)->s_type)
#define       N_NAME(N)        (((N)->t_sp)->s_name)
#define       N_INT(N)         (((N)->t_sp)->s_int)
#define       N_REAL(N)        (((N)->t_sp)->s_real)
#define       T_IDX(N)         ((N)->t_idx)
#define       S_ACCESS(N)      (((N)->t_sp)->s_access_cnt)
#define       LEFT(N)          ((N)->t_left)
#define       LEFT_NAME(N)     ((((N)->t_left)->t_sp)->s_name)
#define       RIGHT(N)         ((N)->t_right)
#define       RIGHT_NAME(N)    ((((N)->t_right)->t_sp)->s_name)

TreeNode_t            *TreeRoot_p;
TreeNode_t            *ArrayTree_p;
TreeNode_t            *FormulaTree_p;

extern   Symbol       *yylval;
extern   int           Symb_count;

#ifdef   USE_DYNAMIC_SYMBOLS
#define  NEW_FIND_IDENTIFIER        /* use t_splay() for variable name lookup */
extern   Symbol       *SymbList_p;
extern   Symbol       *SymbLast_p;
#else
extern   Symbol        SymbArray[MAX_SYMB_COUNT];
#endif

extern   int                Func_idx;
extern   Symbol             FuncStack[MAX_FUNC_NEST];
extern   PointsList_t      *CurrPtsList;
extern   PointsList_t      *LastPtsList;
extern   Symbol            *FmlSymbList_p;
extern   Symbol            *FmlSymbLast_p;
extern   int                FmlSymb_cnt;


extern   double             FormulaVal;
extern   int                FormulaParseOK;

char     Fbuf[ONE_K];          /* lexer input buffer in capaFormulaLexer.c */
int      Fidx;                 /* lexer input char index in capaFormulaLexer.c */



/* ================================================================== */
/* Answer related data structure */
/* 
   char     *ans_str
   int       ans_type
   
   int       ans_weight
   int       ans_tol_type
   double    ans_tol
   int       ans_sig_type
   int       ans_sig_ub
   int       ans_sig_lb
   int       ans_tries
   int       ans_show_hint
   int       ans_show_explain
   char      ans_fmt
   char      ans_unit_str

*/


/* */
void
problem_default(p)Problem_t  *p;
{
  /*
  p->question    = NULL;
  p->answer      = NULL;
  p->hint        = NULL;
  p->explain     = NULL;
  */
  p->next        = NULL;
  p->ans_cnt     = 1;
  p->ans_list    = NULL;
  
  p->weight      = WEIGHT_DEFAULT;
  p->calc        = CALC_DEFAULT;
  p->tol_type    = TOL_ABSOLUTE;
  p->tolerance   = TOL_DEFAULT;
  p->ans_type    = 0;  /* not yet specified */
  p->sig_lbound  = SIG_LB_DEFAULT;
  p->sig_ubound  = SIG_UB_DEFAULT;
  p->pts_list    = NULL;
  p->id_list     = NULL;
  p->partial_cdt = PCREDIT_DEFAULT;
  p->tries       = MAX_TRIES;
  p->ans_unit    = NULL;
  p->show_hint   = SHOW_HINT_DEFAULT;
  p->show_br     = SHOW_BR_DEFAULT;
  p->verbatim    = VERBATIM_DEFAULT;
  p->show_ans_box  = SHOW_ANSBOX_DEFAULT;
  p->capaidplus  = NULL; 
}

void
print_symbarry()
{
#ifdef  USE_DYNAMIC_SYMBOLS
  Symbol   *symb_p, *symb_nextp;

  for(symb_p=SymbList_p; symb_p; symb_p = symb_nextp) {
    symb_nextp = symb_p->s_nextp;
    printf("[%d]<%s> ", (symb_p->s_treep)->t_idx, symb_p->s_name);
  }
  
#else
  int ii;
  
  for(ii=0;ii<Symb_count;ii++) {
    printf("[%d](%s)",ii, SymbArray[ii].s_name);
  }
#endif

}

int        /* RETURNS: <0 LT, 0 EQ, >0 GT  */
comp_name(a,b)char *a, *b;
{              
  int i=0, c,d; 
  
  /* PPDBUG_PR3("Comp_name<%s>,<%s>\n",a,b); */
  do {
      /* compare variable name case insensitively
      c= (isupper(a[i])? tolower(a[i]) : a[i]);
      d= (isupper(b[i])? tolower(b[i]) : b[i]);
      */
      /* variable names are now case sensitive */
      c=a[i]; d=b[i];
      if (c=='@') c=0;
      if (d=='@') d=0;
      i++;
  } while (c==d && c*d);
  return (c-d);
}

int         /* RETURNS: -1 *a LT *b, 0 *a EQ *b, 1 *a GT *b */
comp_namesymbol(a,b)char *a;Symbol  *b;  
{
  if (!b->s_name)   return ( 1);
  if (!a)           return (-1);
  /* PPDBUG_PR3("Comp_namesymbol<%s>,<%s>\n",a,b->s_name); */
  return  strcmp(a, b->s_name);
}

int
itis_empty(root_p) TreeNode_t   *root_p;
{
  return ((root_p == NULL) ? 1: 0);
}


void
print_symb_stat()
{
#ifdef  USE_DYNAMIC_SYMBOLS

  Symbol   *symb_p, *symb_nextp;
#endif  
  
  /* printf("There are %d SYMBOLS.\n", Symb_count); */
  inorder_tree(TreeRoot_p);
  
#ifdef  USE_DYNAMIC_SYMBOLS  
  for(symb_p=SymbList_p; symb_p; symb_p = symb_nextp) {
    symb_nextp = symb_p->s_nextp;
    /* printf("[%d]<%s> ", (symb_p->s_treep)->t_idx, symb_p->s_name); */
  }
#endif 

}
int
preorder_tree(node_p) TreeNode_t  *node_p;
{
  int  result;
  
  if( itis_empty(node_p) )  return (1);
  /* printf("Preorder=%s\n", N_NAME(node_p)); */
  result = preorder_tree(LEFT(node_p));
  if( result ) result = preorder_tree(RIGHT(node_p));
  return (result);
}

int
inorder_tree(node_p) TreeNode_t  *node_p;
{
  int  result;
  
  if( itis_empty(node_p) )  return (1);
  
  result = inorder_tree(LEFT(node_p));
  if( result ) {
    /* printf("<%s,%d,%d> ", N_NAME(node_p),T_IDX(node_p),S_ACCESS(node_p)); */
    printf("%d\t%s\n",S_ACCESS(node_p), N_NAME(node_p));
  }
  result = inorder_tree(RIGHT(node_p));
  
  return (result);
}

int
postorder_tree(node_p) TreeNode_t  *node_p;
{
  int  result;
  
  if( itis_empty(node_p) )  return (1);
  
  result = postorder_tree(LEFT(node_p));
  if( result ) result = postorder_tree(RIGHT(node_p));
  if( result ) printf("Postorder=%s\n", N_NAME(node_p));
  return (result);
}

int
destroy_tree(TreeNode_t  *node_p)
{
  int  result;
  
  
  if( itis_empty(node_p) )  return (1);
  
  result = destroy_tree(LEFT(node_p));
  if( result ) result = destroy_tree(RIGHT(node_p));
  if( node_p != NULL )  node_p->t_sp = NULL;
  if( node_p != NULL ) {
    capa_mfree((char *)node_p);
  }
  return (result);
}

int
free_symtree()
{
#ifndef USE_DYNAMIC_SYMBOLS
  int ii;
#endif

  if(TreeRoot_p != NULL)   destroy_tree(TreeRoot_p); 
  TreeRoot_p = NULL;
  
  if(ArrayTree_p != NULL)  destroy_tree(ArrayTree_p); 
  ArrayTree_p = NULL;


#ifdef  USE_DYNAMIC_SYMBOLS
  {
  Symbol   *symb_p, *symb_nextp;

  /* fprintf(stdout,"FREE symbol counts %d\n",Symb_count); fflush(stdout); */
  for(symb_p=SymbList_p; symb_p; symb_p = symb_nextp) {
    symb_nextp = symb_p->s_nextp;
    
    if( symb_p->s_name != NULL )   {
        capa_mfree((char *)symb_p->s_name);
        /* fprintf(stdout,"FREE symbol<%s>\n",symb_p->s_name); fflush(stdout); */
    }
    switch(symb_p->s_type) {
      case IDENTIFIER:
      case I_VAR:  case I_CONSTANT:
      case R_VAR:  case R_CONSTANT:  break;
      case S_VAR:  case S_CONSTANT: if(symb_p->s_str != NULL)  capa_mfree((char *)symb_p->s_str);
           break;
      default:     break;
    }
    capa_mfree((char *)symb_p);
  }
  SymbList_p = NULL;
  SymbLast_p = NULL;
  
  }
#else
  
  for(ii=0;ii<Symb_count;ii++) {
    switch (SymbArray[ii].s_type) {
        case IDENTIFIER:
        case I_VAR:
        case R_VAR:  capa_mfree(SymbArray[ii].s_name);
                     break;
        case S_VAR:
               capa_mfree(SymbArray[ii].s_name);
               capa_mfree(SymbArray[ii].s_str);
               break;
        default: break;
    }
  }
  
#endif  
  Symb_count = 0;
  /* fprintf(stdout,"FINISH FREE SYMBOLS\n"); fflush(stdout); */
  return (0);
}

char *
btree_search(key,root_pp,compar)char *key;TreeNode_t  **root_pp;int  (*compar)();
{
 TreeNode_t  *root_p, *current_p, *previous_p;  
 int          result;   

   root_p = (TreeNode_t *)*root_pp;
   current_p = root_p;  previous_p = NULL;

   /* Walk tree to find position */
   while (current_p) {
      result=(*compar)(key,current_p->t_sp);
      if (result<0) { 
         previous_p=current_p; current_p = current_p->t_left; 
      } else if (result>0) { 
         previous_p=current_p; current_p = current_p->t_right; 
      } else { 
         ((current_p->t_sp)->s_access_cnt)++;
         return ((char *) &(current_p->t_sp));
      }
   }
#ifdef  USE_DYNAMIC_SYMBOLS
   {  Symbol  *ns_p;
   
   ns_p = (Symbol *)capa_malloc(1,sizeof(Symbol));
   ns_p->s_name = strsave(key);
   ns_p->s_type = IDENTIFIER; 
   ns_p->s_access_cnt = 1;
   ns_p->s_nextp = NULL;
   ns_p->s_prevp = NULL;
   ns_p->s_arrayp = NULL;
   ns_p->s_ptslist = NULL;
   current_p = (TreeNode_t *)capa_malloc(1,sizeof(TreeNode_t));
   ns_p->s_treep = current_p;
   current_p->t_idx = Symb_count;
   current_p->t_sp = ns_p;
   Symb_count++;
   
   if( SymbList_p == NULL ) {
     SymbList_p = ns_p;
   } else {
     ns_p->s_prevp = SymbLast_p; /* put prev symbol in prev pointer */
     SymbLast_p->s_nextp = ns_p;
   }
   SymbLast_p = ns_p;
   
   }
#else

   SymbArray[Symb_count].s_name = strsave(key);  /* *** */
   SymbArray[Symb_count].s_type = IDENTIFIER;
   current_p = (TreeNode_t *)capa_malloc(1,sizeof(TreeNode_t));  /* *** */
   (SymbArray[Symb_count].s_treep) = current_p;
   current_p->t_idx = Symb_count;
   current_p->t_sp = (Symbol *) &(SymbArray[Symb_count]);
   Symb_count++;
   
#endif

   if (previous_p) {  /*  new tree entry */
      result = (*compar)(key,previous_p->t_sp);
      if (result<0) previous_p->t_left = current_p;
      else     previous_p->t_right= current_p;
   } else  /* empty tree */
      *root_pp = (TreeNode_t *)current_p;

   return ((char *) &(current_p->t_sp));
}

/* --------------------------------------------------------------- */
#ifdef     NEW_FIND_IDENTIFIER
Symbol *
find_identifier(name) register char *name;     
{
  TreeNode_t *new_p, *t;
  int         result;

  if (TreeRoot_p == NULL) {  /* a new tree */
      new_p = new_treenode(name,IDENTIFIER);
      TreeRoot_p = new_p;
      return (TreeRoot_p->t_sp);
  }
  t = t_splay(name, TreeRoot_p);
  result = comp_namesymbol(name,t->t_sp) ;
  if( result == 0 ) {
    TreeRoot_p = t;     /* we have found the tree node */
  } else { /* either result < 0 or result > 0 , create a new symbol and new tree node */
    new_p = new_treenode(name,IDENTIFIER);
    if( result < 0 ) {
        new_p->t_left = t->t_left; new_p->t_right = t;
        t->t_left = NULL;
        TreeRoot_p = new_p;
    } else { /* result > 0 */
        new_p->t_right = t->t_right; new_p->t_left = t;
        t->t_right = NULL;
        TreeRoot_p = new_p;
    }
  }
  return (TreeRoot_p->t_sp);
}

#else 

Symbol *
find_identifier(name) register char *name;       
{                         
  register  Symbol **symb_pp;

  if (!(symb_pp = (Symbol **) btree_search(name, &TreeRoot_p, comp_namesymbol)))
     printf("no room");
  
  return(*symb_pp);
}

#endif

/* ================================================================ */

ArgNode_t *
new_arglist( sp ) Symbol *sp;
{
  ArgNode_t *argp;
  
  argp = (ArgNode_t *)capa_malloc(1,sizeof(ArgNode_t)); /* *** */
  argp->a_sp   = sp;
  argp->a_next = NULL;
  argp->a_prev = argp;
  return (argp);
}

ArgNode_t *
addto_arglist( argp, sp ) ArgNode_t *argp; Symbol *sp;
{
  ArgNode_t *tmp_argp;
  tmp_argp = (ArgNode_t *)capa_malloc(1,sizeof(ArgNode_t)); /* *** */
  tmp_argp->a_sp   = sp;
  tmp_argp->a_next = argp;
  tmp_argp->a_prev = tmp_argp;
  argp->a_prev     = tmp_argp;
  return (tmp_argp);

}

void
walk_arglist( argp ) ArgNode_t *argp;
{
  ArgNode_t  *curr_p;
  int         count = 0;
  curr_p = argp;
  while( curr_p != NULL ) {
    count++;
    switch( (curr_p->a_sp)->s_type ) {
      case IDENTIFIER: printf("(%d:id%s)",count,(curr_p->a_sp)->s_name ); break;
      case I_VAR:      printf("[%s",(curr_p->a_sp)->s_name);
      case I_CONSTANT: printf("(%d:%ld)",count,(curr_p->a_sp)->s_int ); break;
      case R_VAR:      printf("[%s",(curr_p->a_sp)->s_name);
      case R_CONSTANT: printf("(%d:%g)",count,(curr_p->a_sp)->s_real ); break;
      case S_VAR:      printf("[%s",(curr_p->a_sp)->s_name);
      case S_CONSTANT: printf("(%d:%s)",count,(curr_p->a_sp)->s_str ); break;
      default: break;
    }
    curr_p = curr_p->a_next;
  }
}
void
free_arglist( argp ) ArgNode_t *argp;
{
  ArgNode_t  *curr_p, *next_p;

  curr_p = argp;
  while( curr_p != NULL ) {
    switch( (curr_p->a_sp)->s_type ) {
      case IDENTIFIER:  break;
      case I_VAR:       break;
      case I_CONSTANT:  capa_mfree((char *)(curr_p->a_sp));  break;
      case R_VAR:       break;
      case R_CONSTANT:  capa_mfree((char *)(curr_p->a_sp));  break;
      case S_VAR:       break;
      case S_CONSTANT:  capa_mfree((char *)((curr_p->a_sp)->s_str));
                        capa_mfree((char *)(curr_p->a_sp));  break;
      default:          break;
    }
    next_p = curr_p->a_next;
    capa_mfree((char *)curr_p);
    curr_p = next_p;
  } 
  
}

/* ================ Assuming the input string is a legal real number */
int
calc_sig( a_num ) char *a_num;
{
  int    idx, whole_len=0, frac_len, prim_len, exp_len, s_len=0;
  int    primary, sig_count;
  char  *dot_p, *idx_p, i_num[64];

  while( (!isdigit(a_num[0])) && (a_num[0] != '.' ) )  a_num++;  /* process numbers like .1234 and -.1234 */
  if( a_num != NULL)  whole_len = strlen(a_num);
  if( index(a_num, '.' ) == NULL ) {
    if( (index(a_num,'e') == NULL) && (index(a_num,'E') == NULL) ) {
      exp_len = 0;
    } else {
      /*** hpux complained */
      exp_len = ( (index(a_num,'e') == NULL) ? strlen(index(a_num,'E')) : strlen(index(a_num,'e')) );
    }
    while( a_num[0] == '0' )  a_num++;
    if( a_num != NULL)  s_len = strlen(a_num);
    sig_count = ( ((s_len - exp_len) <= 0)? 0 : s_len - exp_len);
    if( sig_count > 0 ) {
      idx_p = (char *)(&a_num[sig_count-1]);
      while( *idx_p == '0' || *idx_p == ' ') { idx_p--; sig_count--; }
    }
  } else {    /* contains '.' */
    if( (index(a_num,'e') == NULL) && (index(a_num,'E') == NULL) ) {
      exp_len = 0;
    } else {  /* contains either 'e' or 'E' */
      /*** hpux complained */
      exp_len = ( (index(a_num,'e') == NULL) ? strlen(index(a_num,'E')) : strlen(index(a_num,'e')) );
    }
    dot_p = index(a_num,'.');   dot_p++;
    if( dot_p != NULL)  { frac_len = strlen(dot_p) - exp_len; } else { frac_len = 0; }
    idx_p = dot_p;
    while( idx_p[0] == '0' ) idx_p++;
    prim_len = whole_len - frac_len - exp_len - 1;
    if(prim_len == 0 ) {
      primary = 0;
    }else{
      for(idx=0;idx< prim_len;idx++) i_num[idx] = a_num[idx];
      i_num[prim_len] = 0;
      sscanf(i_num, "%d", &primary);
    }
    if(primary == 0 ) {
       sig_count = strlen(idx_p) - exp_len; 
    } else {
       sig_count = prim_len + strlen(dot_p) - exp_len; 
    }
  }
  return (sig_count);

}
int
endian()
{
  union { long lng; char ch[sizeof(long)]; } un;
  
  un.lng = 1L;
  
  if(un.ch[0]) return (0); 
  return (1);
}

/* -------------------------------- Array related routines ------------ */

/* creates a new tree node and a symbol data structure associated 
   with it. Initialize the symbol with name_p, and type 
*/

TreeNode_t *
new_treenode(name_p,type)char *name_p;int type;
{
    Symbol      *ns_p;
    TreeNode_t  *new_p;
    
    ns_p = (Symbol *)capa_malloc(1,sizeof(Symbol));
    ns_p->s_name       = strsave(name_p);
    ns_p->s_type       = type;
    ns_p->s_array_cnt  = 0;
    ns_p->s_argc       = 0;
    ns_p->s_argp       = NULL;
    ns_p->s_arrayp     = NULL;
    ns_p->s_treep      = NULL;
    ns_p->s_nextp      = NULL;
    ns_p->s_prevp      = NULL;
    ns_p->s_access_cnt = 1;
    new_p = (TreeNode_t *)capa_malloc(1,sizeof(TreeNode_t));
    
    ns_p->s_treep      = new_p;
    
    new_p->t_idx       = Symb_count;
    new_p->t_sp        = ns_p;
    Symb_count++;
   
    if( SymbList_p == NULL ) {
      SymbList_p = ns_p;
    } else {
      ns_p->s_prevp = SymbLast_p;
      SymbLast_p->s_nextp = ns_p;
    }
    SymbLast_p = ns_p;
    
    return (new_p);
}

TreeNode_t *
new_formulanode(name_p,val)char *name_p;double val;
{
    Symbol      *ns_p;
    TreeNode_t  *new_p;
    
    ns_p = (Symbol *)capa_malloc(1,sizeof(Symbol));
    ns_p->s_name       = strsave(name_p);
    ns_p->s_type       = R_VAR;
    ns_p->s_real       = val;
    ns_p->s_array_cnt  = 0;
    ns_p->s_arrayp     = NULL;
    ns_p->s_argc       = 0;
    ns_p->s_argp       = NULL;
    ns_p->s_treep      = NULL;
    ns_p->s_nextp      = NULL;
    ns_p->s_access_cnt = 1;
    new_p = (TreeNode_t *)capa_malloc(1,sizeof(TreeNode_t));
    
    ns_p->s_treep      = new_p;
    
    new_p->t_idx       = FmlSymb_cnt;
    new_p->t_sp        = ns_p;
    FmlSymb_cnt++;
    if( FmlSymbList_p == NULL ) {
      FmlSymbList_p = ns_p;
    } else {
      FmlSymbLast_p->s_nextp = ns_p;
    }
    FmlSymbLast_p = ns_p;
    
    return (new_p);
}



/* Splay tree is used in the search */

TreeNode_t *
t_splay (name, t)char *name;TreeNode_t *t;
{
  TreeNode_t     N;
  TreeNode_t    *l, *r, *y;

  if (t == NULL)  return t;
  N.t_left  = (TreeNode_t *)NULL;
  N.t_right = (TreeNode_t *)NULL;
  l = r = &N;

  for (;;) {
    if ( comp_namesymbol(name,t->t_sp) < 0 ) {
      if (t->t_left == NULL)  break;
      if ( comp_namesymbol(name, (t->t_left)->t_sp ) < 0 ) {
        y = t->t_left; t->t_left = y->t_right; y->t_right = t; t = y;
        if (t->t_left == NULL) break;
      }
      r->t_left = t; r = t; t = t->t_left;
    } else if ( comp_namesymbol(name,t->t_sp) > 0 ) {
        if (t->t_right == NULL) break;
        if ( comp_namesymbol(name, (t->t_right)->t_sp ) > 0 ) {
          y = t->t_right; t->t_right = y->t_left; y->t_left = t; t = y;
          if (t->t_right == NULL) break;
        }
        l->t_right = t; l = t; t = t->t_right;
    } else {
      break;
    }
  }
  l->t_right = t->t_left; r->t_left = t->t_right; t->t_left = N.t_right;
  t->t_right = N.t_left;
  return t;
}

/* find array symbol with a given name *name_p */
/*  */
/* the result of search will be in tree node pointer ArrayTree_p */
/* array will be storded at a linked list */
/* with the first symbol containing the main name of the array */
/* array[1] is different from array["1"] */
/* it will be given a resulting symbol no matter the given name_p */
/* appear on the tree or not. It create one new node when name_p */
/* is not found in the global name tree */

Symbol *
find_arrayid(name_p) char *name_p;       
{
  TreeNode_t *new_p, *t;
  int         result;

  if (ArrayTree_p == NULL) {  /* a new tree */
      new_p = new_treenode(name_p,IDENTIFIER);
      ArrayTree_p = new_p;
      return (ArrayTree_p->t_sp);
  }
  t = t_splay(name_p, ArrayTree_p);
  result = comp_namesymbol(name_p,t->t_sp) ;
  if( result == 0 ) {
    ArrayTree_p = t;     /* we have found the tree node */ 
  } else { /* either result < 0 or result > 0 , create a new symbol and new tree node */
    new_p = new_treenode(name_p,IDENTIFIER);  /* create a new identifier node */
    if( result < 0 ) {
        new_p->t_left = t->t_left; new_p->t_right = t;
        t->t_left = NULL;
        ArrayTree_p = new_p;
    } else { /* result > 0 */
        new_p->t_right = t->t_right; new_p->t_left = t;
        t->t_right = NULL;
        ArrayTree_p = new_p;
    }
  }
  return (ArrayTree_p->t_sp); /* return the symbol */
}


void
print_array_element(array_p)Symbol *array_p;
{
  Symbol  *c_p;

  fprintf(stdout,"ARRAY:%s<%d,%d>::",array_p->s_name,array_p->s_type,array_p->s_array_cnt); fflush(stdout);
  for(c_p = array_p->s_arrayp; c_p; c_p = c_p->s_arrayp) {
    fprintf(stdout,"[%s<%d>] ",c_p->s_name,c_p->s_type); fflush(stdout);
  }
  fprintf(stdout,"\n"); fflush(stdout);

}

/* */
Symbol *
find_array_by_index(array_p,idx_p)Symbol *array_p; char *idx_p;
{
  Symbol *symb_p, *ns_p;
  int     not_found=1;
  
  /* this is a linear search for an array item */
  
  if( array_p->s_arrayp == NULL ) {
    not_found = 1;
  }
  symb_p = array_p;
  for(ns_p=array_p->s_arrayp; (ns_p)&&(not_found); ns_p = ns_p->s_arrayp) {
    not_found = comp_namesymbol(idx_p,ns_p);
    symb_p = ns_p;
  }
  if(not_found) { /* make a new symbol */
    ns_p = (Symbol *)capa_malloc(1,sizeof(Symbol));
    ns_p->s_name       = strsave(idx_p);
    ns_p->s_type       = IDENTIFIER;
    ns_p->s_array_cnt  = 0;
    ns_p->s_argc       = 0;
    ns_p->s_argp       = NULL;
    ns_p->s_treep      = NULL;
    ns_p->s_nextp      = NULL;
    ns_p->s_prevp      = NULL;
    ns_p->s_arrayp     = NULL;
    ns_p->s_access_cnt = 1;
    array_p->s_array_cnt++;  /* add one to the count stored in array master id's symbol */
    symb_p->s_arrayp = ns_p;  /* attach the new symbol to the end of linked list */
    Symb_count++;             /* link the newly created symbol to the global linked list */
    if( SymbList_p == NULL ) { /* place the symbol in the global linear list */
      SymbList_p = ns_p;
    } else {
      ns_p->s_prevp = SymbLast_p; /* put the previous symbol in prev pointer */
      SymbLast_p->s_nextp = ns_p;
    }
    SymbLast_p = ns_p;
    /*
    fprintf(stdout,"ARR element NOTFOUND, NEW master array name=%s, idx=%s,type=%d\n",array_p->s_name,ns_p->s_name,ns_p->s_type);
    fflush(stdout);
    */
  } else {/* found the array symbol */
    ns_p = symb_p; /* rewind one position */
    /*
    fprintf(stdout,"FOUND master name=%s, idx=%s,type=%d\n",array_p->s_name,ns_p->s_name,ns_p->s_type);
    fflush(stdout);
    */
  }
  
  /*
  fprintf(stdout,"post find_array_by_index()::"); fflush(stdout);
  print_array_element(array_p);
  */
  return (ns_p);
}

/* converts array_str[1], array_str[2], ... array_str[i_cnt] into */
/* (*output_pp)[1], (*output_pp)[2], ... (*output_pp)[i_cnt] */
/* returns the number of elements converted */
int  conv_array_float(output_pp,array_str,i_cnt) float  **output_pp; char *array_str;int i_cnt;
{
  TreeNode_t  *t;
  Symbol      *arr_p, *mem_p, *resultp, **tmp_p;
  int          result, conv_cnt, a_idx;
  char         fmt_str[MAX_BUFFER_SIZE];
  
  t = t_splay(array_str, ArrayTree_p);
  ArrayTree_p = t;  /* make the global tree correct */
  result = comp_namesymbol(array_str,t->t_sp);
  arr_p = t->t_sp; /* arr_p is the major array symbol */
  if( result == 0 ) { /* we have found the array symbol node */
    sprintf(fmt_str,"%s[%%d]",array_str);
    conv_cnt = 0;
    if( arr_p->s_arrayp != NULL ) {
      mem_p = arr_p;
      for(mem_p=arr_p->s_arrayp; (mem_p); mem_p = mem_p->s_arrayp) {
        sscanf(mem_p->s_name,fmt_str, &a_idx);
        if( (1 <= a_idx) && (a_idx <= i_cnt) ) {
          switch(mem_p->s_type) {
            case IDENTIFIER:        break; /* do nothing, let later routing catch this error */
            case I_VAR: case I_CONSTANT: 
              (*output_pp)[a_idx-1] = (float)mem_p->s_int;
              conv_cnt++;
              break;
            case R_VAR: case R_CONSTANT:
              (*output_pp)[a_idx-1] = mem_p->s_real;
              conv_cnt++;
              break;
            case S_VAR: case S_CONSTANT:   break; /* do nothing, let later routing catch this error */
          }
        }
      } /* end for mem_p */
    } /* end if arr_p->s_arrayp not NULL */
  } else { /* array symbol not found */
    conv_cnt = -1;
  }
  return (conv_cnt);
}







/* generate multivariate normal random variables according to */
/* the given mean and covariance matrix */
/* */
Symbol  *gen_multivariate_normal(output_p,seed,item_cnt,dimen,m_vec_str,c_vec_str)
char *output_p;char *seed;int item_cnt;int dimen;char *m_vec_str;char *c_vec_str;
{
  Symbol      *arr_p, *mem_p, *resultp, **tmp_p;
  long         seed1, seed2, orig_gen, current_gen;
  char         idx_str[MAX_BUFFER_SIZE],error_str[MAX_BUFFER_SIZE];
  int          i, j, result, total_cnts, param_cnt, cov_cnt, no_error;
  float       *m_vec, *c_vec, *param_vec, *r_vec, *t_vec;
  
  total_cnts = item_cnt * dimen;
  resultp = (Symbol *)capa_malloc(1,sizeof(Symbol));
  resultp->s_type = I_CONSTANT;
  resultp->s_int  = total_cnts;
  
  no_error = 1;
  m_vec = (float *)capa_malloc(sizeof(float),dimen);
  result = conv_array_float(&m_vec,m_vec_str,dimen);
  
  if( result < 0) {
    sprintf(error_str,"<<ARRAY %s ELEMENT TYPE>>",m_vec_str);
    resultp->s_type = S_CONSTANT;
    resultp->s_str = strsave(error_str);
    sprintf(error_str,"random_multivariate_normal()'s mean array arg. does not contain any element.\n");
    capa_msg(MESSAGE_ERROR,error_str);
    no_error = 0;
  } 
  if(result != dimen) {
    /* something wrong with mean vector */
    sprintf(error_str,"<<ARRAY %s ELEMENT TYPE>>",m_vec_str);
    resultp->s_type = S_CONSTANT;
    resultp->s_str = strsave(error_str);
    sprintf(error_str,"random_multivariate_normal()'s mean array arg. contains element of incorrect type.\n");
    capa_msg(MESSAGE_ERROR,error_str);
    no_error = 0;
  }
  if(no_error) { /* covariance matrix is positive definite and of dimension dimen * dimen */
    cov_cnt = dimen * dimen;
    
    c_vec = (float *)capa_malloc(sizeof(float),cov_cnt);
    result = conv_array_float(&c_vec,c_vec_str,cov_cnt);
    if(result < 0) {
      sprintf(error_str,"<<ARRAY %s ELEMENT TYPE>>",c_vec_str);
      resultp->s_type = S_CONSTANT;
      resultp->s_str = strsave(error_str);
      sprintf(error_str,"random_multivariate_normal()'s covariance array arg. does not contain any element.\n");
      capa_msg(MESSAGE_ERROR,error_str);
      no_error = 0;
    }
    if( result != cov_cnt) {
    /* something wrong with covariance vector */
      sprintf(error_str,"<<ARRAY %s ELEMENT TYPE>>",c_vec_str);
      resultp->s_type = S_CONSTANT;
      resultp->s_str = strsave(error_str);
      sprintf(error_str,"random_multivariate_normal()'s covariance array arg. contains element of incorrect type.\n");
      capa_msg(MESSAGE_ERROR,error_str);
      no_error = 0;
    }
  }
  
  if( no_error ) {
    
    arr_p = find_arrayid(output_p);
    /* whether output_p is a new array name or not doesn't matter, we are creating one if needed */
    tmp_p = (Symbol_p *)capa_malloc(total_cnts,sizeof(Symbol *)); /* the resulting number of elements */
    for (i=0;i<total_cnts;i++) { /* total_cnt must be positive */
      sprintf(idx_str,"%s[%d]",output_p,i);
      tmp_p[i] = find_array_by_index(arr_p,idx_str);
      /* don't matter if they have been previously defined */
    }
    gscgn(GET_GENERATOR, &orig_gen);
    current_gen = (long)MULTIVARIATE_NORMAL_DIS;
    gscgn(SET_GENERATOR, &current_gen);
    phrtsd(seed, &seed1, &seed2);
    setsd(seed1, seed2);
    param_cnt = dimen * (dimen + 3 )/ 2 + 1;
    param_vec = (float *)capa_malloc(sizeof(float),param_cnt);
    r_vec = (float *)capa_malloc(sizeof(float),dimen); /* resulting point vector */
    t_vec = (float *)capa_malloc(sizeof(float),dimen); /* working area point vector */
    
    /* set the random number seed */
    setgmn(m_vec,c_vec,(long)dimen,param_vec);

    for(i=0;i<total_cnts;) {
       genmn(param_vec,r_vec,t_vec);
       for(j=0;j<dimen;j++) {
         tmp_p[i]->s_type = R_VAR;
         tmp_p[i]->s_real = r_vec[j];
         i++;
       }
    }
    gscgn(SET_GENERATOR, &orig_gen);
    capa_mfree((char *)r_vec);  capa_mfree((char *)t_vec);
    
  }
  if(m_vec != NULL)     capa_mfree((char *)m_vec);
  if(c_vec != NULL)     capa_mfree((char *)c_vec);
  return (resultp);

}


/* generates a number of random numbers from a certain kind of 
   distribution specified by the selector and the seed
*/
Symbol  *gen_random_by_selector(output_p,sel,seed,item_cnt,p1,p2)
char *output_p; int sel; char *seed; int item_cnt;float p1;float p2;
{
  long         seed1, seed2, orig_gen, current_gen;
  Symbol      *a_p, *resultp, **tmp_p;
  int          i;
  char         idx_str[MAX_BUFFER_SIZE];
  float        num_f;
    
  /* setup the output array with all its elements */
  
  a_p = find_arrayid(output_p);  
  /* whether output_p is a new symbol or not doesn't matter */

  tmp_p = (Symbol_p *)capa_malloc(item_cnt,sizeof(Symbol *));

  for (i=0;i<item_cnt;i++) { /* item_cnt must be positive */
      sprintf(idx_str,"%s[%d]",output_p,i);
      tmp_p[i] = find_array_by_index(a_p,idx_str);
      /* don't matter if they have been previously defined */
  }
  resultp = (Symbol *)capa_malloc(1,sizeof(Symbol));
  resultp->s_type = I_CONSTANT;
  resultp->s_int = item_cnt;

  gscgn(GET_GENERATOR, &orig_gen);
  current_gen = (long)sel;
  gscgn(SET_GENERATOR, &current_gen);
  phrtsd(seed, &seed1, &seed2);
  setsd(seed1, seed2);
  switch(sel) {
    case NORMAL_DIS: /* gennor(av, sd)->snorm()->ranf() */
         for (i=0;i<item_cnt;i++) { 
           tmp_p[i]->s_type = R_VAR;
           num_f = gennor(p1,p2);
           /* printf("GENNOR()=%f\n",num_f); fflush(); */
           tmp_p[i]->s_real = num_f;
         }
         break;
    case POISSON_DIS:  /* long ignpoi(float mu)->snorm(),ranf(),sexpo() */
         for (i=0;i<item_cnt;i++) { 
           tmp_p[i]->s_type = I_VAR;
           tmp_p[i]->s_int = ignpoi(p1);
         }
         break;
    case EXPONENTIAL_DIS: /* float genexp(float av) -> sexpo(),ranf() */
         for (i=0;i<item_cnt;i++) { 
           tmp_p[i]->s_type = R_VAR;
           tmp_p[i]->s_real = (double)genexp(p1);
         }
         break;
    case BETA_DIS:  /* float genbet(float aa,float bb)-> ranf() */
         for (i=0;i<item_cnt;i++) { 
           tmp_p[i]->s_type = R_VAR;
           tmp_p[i]->s_real = (double)genbet(p1,p2);
         }
         break;
    case GAMMA_DIS: /* float gengam(float a,float r)->sgamma(),snorm(),ranf(),sexpo() */
         for (i=0;i<item_cnt;i++) { 
           tmp_p[i]->s_type = R_VAR;
           tmp_p[i]->s_real = (double)gengam(p1,p2);
         }
         break;

    case CHI_DIS: /* float genchi(float df) genchi = 2.0*gengam(1.0,df/2.0) */
         for (i=0;i<item_cnt;i++) { 
           tmp_p[i]->s_type = R_VAR;
           tmp_p[i]->s_real = (double)genchi(p1);
         }
         break;
    case NONCENTRAL_CHI_DIS: /* float gennch(float df,float xnonc)
                  gennch = genchi(df-1.0)+pow(gennor(sqrt(xnonc),1.0),2.0);
                             */
         for (i=0;i<item_cnt;i++) { 
           tmp_p[i]->s_type = R_VAR;
           tmp_p[i]->s_real = (double)gennch(p1,p2);
         }
         break;
  }
  /* restore to the original random generator */ 
  gscgn(SET_GENERATOR, &orig_gen);

  return (resultp);
}


/* free all elements associated with array name (*name_p)[] */
/* also free the associated symbol from SymbList_p and update it accordingly */
/* return the number of array elements got deleted */
/*        -1 means the given string *name_p is not defined as an array name */
/* the input char *name_p is not freed by this routine */
int     free_array(name_p)char *name_p;
{
  TreeNode_t  *t;
  int          result, deleted_cnt=0;
  Symbol      *arr_p,  *mem_p, *next_p;
  Symbol      *left_p,  *right_p;

  if (ArrayTree_p == NULL) {  /* a new array symbol tree, do nothing. */   return -1;  }
  
  
  t = t_splay(name_p, ArrayTree_p);
  ArrayTree_p = t;  /* make the global tree correct */
  result = comp_namesymbol(name_p,t->t_sp);
  arr_p = t->t_sp; /* arr_p is the major array symbol */
  if( result == 0 ) { /* we have found the array symbol node */
    if( arr_p->s_arrayp != NULL ) {
      for(mem_p=arr_p->s_arrayp;mem_p; mem_p = next_p) {
         next_p = mem_p->s_arrayp;
         if( mem_p->s_name != NULL ) {
           capa_mfree((char *)mem_p->s_name); /* free the associated array index name */
         }
         if( mem_p->s_type == S_VAR && mem_p->s_str != NULL ) {
           capa_mfree((char *)mem_p->s_str); /* free the associated string */
         }
         if( mem_p->s_nextp == NULL ) { /* the very last member in SymbList_p */
           SymbLast_p = mem_p->s_prevp;
           SymbLast_p->s_nextp = NULL;  /* delimit the prev symbol as the last one */
         } else { /* in the middle of SymbList_p */
           left_p = mem_p->s_prevp;
           right_p = mem_p->s_nextp;
           left_p->s_nextp = right_p;
           right_p->s_prevp = left_p;
         }
         Symb_count--;             /* decrease the count */
         deleted_cnt++;            /* keep a tab on how many got deleted */
         capa_mfree((char *)mem_p);
      }
      arr_p->s_arrayp = NULL;  /* empty membership */
      arr_p->s_array_cnt  = 0;
    } 
  } else { /* either result < 0 or result > 0 , the name_p is not an array name */
    deleted_cnt = -1;
  }
  return (deleted_cnt);
}


#define   MAX_DOUBLE         1.7976931348623157E+308
#define   MIN_DOUBLE         2.2250738585072014E-308

/*  */
Symbol     *array_min_max(name_p,min)char *name_p;int min;
{
  TreeNode_t  *t;
  int          result, no_error=1;
  Symbol      *a_p,  *ns_p, *resultp;
  double       tmp_r, new;
  char         aline[MAX_BUFFER_SIZE], tmp_str[MAX_BUFFER_SIZE];
  
  if (ArrayTree_p == NULL) {  /* a new tree */
      return (NULL);  /* array not found */
  }

  t = t_splay(name_p, ArrayTree_p);
  ArrayTree_p = t;  /* make the global tree correct */
  result = comp_namesymbol(name_p,t->t_sp);
  a_p = t->t_sp;

  if( result == 0 ) { /* we have found the array symbol node */
    /* fprintf(stdout,"MINMAX()found:: "); fflush(stdout); print_array_element(a_p); */
    tmp_r = ((min)? MAX_DOUBLE : - MAX_DOUBLE);
      
    resultp = (Symbol *)capa_malloc(1,sizeof(Symbol));
    resultp->s_type = R_CONSTANT;

    /* first performs a test to see if a_p->s_arrayp is null or not */
    if( a_p->s_arrayp == NULL ) {
      sprintf(aline,"<<ARRAY ELEMENT NOT DEFINED>>");
      resultp->s_type = S_CONSTANT;
      resultp->s_str = strsave(aline);
      no_error = 0;
    }
    for(ns_p=a_p->s_arrayp; (ns_p)&&(no_error); ns_p = ns_p->s_arrayp) {
       switch(ns_p->s_type) {
         case IDENTIFIER: 
              break;
         case I_VAR: case I_CONSTANT: 
              new = (double)ns_p->s_int;
              break;
         case R_VAR: case R_CONSTANT:
              new = ns_p->s_real;
              break;
         case S_VAR: case S_CONSTANT: 
              sprintf(aline,"<<ARRAY ELEMENT TYPE>>");
              resultp->s_type = S_CONSTANT;
              resultp->s_str = strsave(aline);
              sprintf(tmp_str,"%s()'s array arg. contains element of type string.\n", (min?"min":"max") );
              capa_msg(MESSAGE_ERROR,tmp_str);
              no_error = 0;
              break;
       }
       if( no_error ) {
         tmp_r= ((min)? ((tmp_r < new)? tmp_r : new) : ((tmp_r < new)? new : tmp_r));
       }
    }
    if( no_error ) {
      resultp->s_real = tmp_r;
    }
    return (resultp);
  } else { /* either result < 0 or result > 0 , the name_p is not an array name */
          /* do not add name_p to the global array symbol tree */
    return (NULL);
  }
  
}

/* calculate number of elements, mean value, variance, skewness, */
/* and kurtosis as the */
/* zeroth, first, second, third and fourth moments of input array name_p */
/* and place the result in array output_p */
/* what if name_p and output_p are the same ? */
/* an error will signify this situation */
/* IT */

Symbol     *array_moments(output_p,name_p)char *output_p; char *name_p;
{
  TreeNode_t  *t;
  int          result, no_error=1;
  Symbol      *a_p,  *i_p, *ns_p, *resultp, *tmp_p[5];
  double       new, sum_r, s_variance, s_mean, s_std_dev, s_skewness, s_kurtosis;
  double       s_delta, s_sum_delta, s_product;
  char         aline[MAX_BUFFER_SIZE], tmp_str[MAX_BUFFER_SIZE];
  int          i, s_cnt;
  char         idx_str[MAX_BUFFER_SIZE];
  
  /* make sure that name_p and output_p is not equal */
  
  
  /* create the output array with all its elements */
  
  a_p = find_arrayid(output_p);  /* output_p is a new symbol or not doesn't matter */
  for (i=0;i<5;i++) { /* only upto fourth moments */
      sprintf(idx_str,"%s[%d]",output_p,i);
      tmp_p[i] = find_array_by_index(a_p,idx_str);
      /* check to see if they are previously defined */
  }
  resultp = (Symbol *)capa_malloc(1,sizeof(Symbol));
  resultp->s_type = I_CONSTANT;
  if (ArrayTree_p == NULL) {  /* a new tree */
      sprintf(aline,"<<ARRAY %s[] NOT DEFINED>>",name_p);
      resultp->s_type = S_CONSTANT;
      resultp->s_str = strsave(aline);
      return (resultp);  /* array not found */
  }
  t = t_splay(name_p, ArrayTree_p);
  ArrayTree_p = t;  /* make the global tree correct */
  result = comp_namesymbol(name_p,t->t_sp);
  i_p = t->t_sp;
  if( result == 0 ) { /* we have found the array symbol node */
    /* first performs a test to see if a_p->s_arrayp is null or not */
    if( i_p->s_arrayp == NULL ) {
      sprintf(aline,"<<ARRAY ELEMENT NOT DEFINED>>");
      resultp->s_type = S_CONSTANT;
      resultp->s_str = strsave(aline);
      return (resultp);  /* array element not found */
    }
    /* print_array_element(i_p); fflush(stdout); */
    s_cnt = 0; sum_r = 0.0;
    for(ns_p=i_p->s_arrayp; (ns_p)&&(no_error); ns_p = ns_p->s_arrayp) {
       s_cnt++;
       switch(ns_p->s_type) {
         case IDENTIFIER: /* skip identifier */
              break;
         case I_VAR: case I_CONSTANT: 
              new = (double)ns_p->s_int;
              break;
         case R_VAR: case R_CONSTANT:
              new = ns_p->s_real;
              break;
         case S_VAR: case S_CONSTANT: 
              sprintf(aline,"<<ARRAY ELEMENT TYPE>>");
              resultp->s_type = S_CONSTANT;
              resultp->s_str = strsave(aline);
              sprintf(tmp_str,"array_moments()'s array arg. contains element of type string.\n");
              capa_msg(MESSAGE_ERROR,tmp_str);
              no_error = 0;
              break;
       }
       if( no_error ) {
         sum_r  +=  new;
       }
    }
    if( no_error ) {  /* second pass */
      s_mean = sum_r/(double)s_cnt;
      
      s_delta = 0.0; s_sum_delta=0.0; 
      s_variance = 0.0; s_skewness = 0.0; s_std_dev = 0.0; s_kurtosis = 0.0;
      no_error = 1;
      for(ns_p=i_p->s_arrayp; (ns_p)&&(no_error); ns_p = ns_p->s_arrayp) {
        switch(ns_p->s_type) {
           case IDENTIFIER: 
              break;
           case I_VAR: case I_CONSTANT: 
              new = (double)ns_p->s_int;
              break;
           case R_VAR: case R_CONSTANT:
              new = ns_p->s_real;
              break;
           case S_VAR: case S_CONSTANT: 
              sprintf(aline,"<<ARRAY ELEMENT TYPE>>");
              resultp->s_type = S_CONSTANT;
              resultp->s_str = strsave(aline);
              sprintf(tmp_str,"array_moments()'s array arg. contains element of type string.\n");
              capa_msg(MESSAGE_ERROR,tmp_str);
              no_error = 0;
              break;
         }
         if( no_error ) {
           s_delta = new - s_mean;
           s_sum_delta += s_delta;
           s_variance  += (s_product = s_delta * s_delta);
           s_skewness  += ( s_product *= s_delta );
           s_kurtosis  += ( s_product *= s_delta );      
         }
       }
       if( no_error ) {
         resultp->s_int = s_cnt;
         resultp->s_type = I_CONSTANT;
         s_variance = (s_variance - s_sum_delta * s_sum_delta/s_cnt)/(s_cnt-1);
         s_std_dev = sqrt(s_variance);
         if( s_variance != 0.0 ) {
           s_skewness /= (s_cnt * s_variance * s_std_dev ) ;
           s_kurtosis = s_kurtosis / (s_cnt * s_variance * s_variance) - 3.0;
         } else { /* no skew and kurtosis when variance is 0.0 */
           sprintf(aline,"<<VARIANCE is 0.0, NO SKEWNESS AND KURTOSIS!>>");
           resultp->s_type = S_CONSTANT;
           resultp->s_str = strsave(aline);
           s_skewness=0.0;s_kurtosis=0.0;
         }
         
         
         
         tmp_p[0]->s_type = I_VAR;
         tmp_p[0]->s_int  = s_cnt;
         tmp_p[1]->s_type = R_VAR;
         tmp_p[1]->s_real = s_mean;
         tmp_p[2]->s_type = R_VAR;
         tmp_p[2]->s_real = s_variance;
         tmp_p[3]->s_type = R_VAR;
         tmp_p[3]->s_real = s_skewness;
         tmp_p[4]->s_type = R_VAR;
         tmp_p[4]->s_real = s_kurtosis;
         
         /*
         print_array_element(a_p); fflush(stdout);
         fprintf(stdout,"\n[%d,%.15g,%.15g,%.15g,%.15g]\n",s_cnt,s_mean,s_variance,s_skewness,s_kurtosis);
         fflush(stdout);
         */
       }
    } 
  } else { /* either result < 0 or result > 0 , the name_p is not an array name */
          /* do not add name_p to the global array symbol tree */
    sprintf(aline,"<<The Array %s[] is not on defined>>",name_p);
    resultp->s_type = S_CONSTANT;
    resultp->s_str = strsave(aline);
  }
  
  return (resultp);
 
}




/* ============================================================= */
/*    setup the symbol tree for formula id  */
/*    after setup these variables and vaules, the symbol tree remains */
/*    until next setup */
int
setup_formula_id(v_str,pt_str) char *v_str; char *pt_str;
{
  TreeNode_t *new_p, *t;
  int         result, v_cnt, f_cnt, i, error=0;
  char      **v_ar;
  double     *f_ar;
  char        warn_msg[WARN_MSG_LENGTH];
  
  free_formula_tree();
  
  v_cnt = f_str_to_ids(&v_ar, v_str);
  f_cnt = f_str_to_numbers( &f_ar, pt_str);
  if( v_cnt == f_cnt ) {
    for(i=0;i<v_cnt;i++) {
      if ( i == 0 ) {  /* initial condition */
        new_p = new_formulanode(v_ar[i],f_ar[i]);
        FormulaTree_p = new_p;
      } else {
        t = t_splay(v_ar[i], FormulaTree_p);
        result = comp_namesymbol(v_ar[i],t->t_sp) ;
        if( result == 0 ) {
          FormulaTree_p = t;     /* we have found the tree node , this should not happen! */
          sprintf(warn_msg,"In setup formula variable tree, same symbols are used.\n");
          capa_msg(MESSAGE_ERROR,warn_msg); 
          error=1;
        } else { /* either result < 0 or result > 0 , create a new symbol and new tree node */
          new_p = new_formulanode(v_ar[i],f_ar[i]);
          if( result < 0 ) {
            new_p->t_left = t->t_left; new_p->t_right = t;
            t->t_left = NULL;
            FormulaTree_p = new_p;
          } else { /* result > 0 */
            new_p->t_right = t->t_right; new_p->t_left = t;
            t->t_right = NULL;
            FormulaTree_p = new_p;
          }
        }
      }
    } /* for i */
  } else {
    sprintf(warn_msg,"Something wrong when in setup formula variable tree.\n");
    capa_msg(MESSAGE_ERROR,warn_msg); error=1;
  }
  capa_mfree((char *)f_ar);
  for(i=0;i<v_cnt;i++) {
    capa_mfree((char *)(v_ar[i]));
  }
  capa_mfree((char *)v_ar);
  if( error == 1 ) {
    return (0);
  } else {
    return (v_cnt);
  }
  
}

void
free_formula_tree()
{
  Symbol   *symb_p, *symb_nextp;

  if(FormulaTree_p != NULL)   destroy_tree(FormulaTree_p); 
  FormulaTree_p = NULL;
  
  for(symb_p=FmlSymbList_p; symb_p; symb_p = symb_nextp) {
    symb_nextp = symb_p->s_nextp;
    capa_mfree((char *)symb_p->s_name);
    switch(symb_p->s_type) {
      case IDENTIFIER:
      case I_VAR:
      case R_VAR:  break;
      case S_VAR:  capa_mfree((char *)symb_p->s_str);
           break;
      default:     break;
    }
    capa_mfree((char *)symb_p);
  }
  FmlSymbList_p = NULL;
  FmlSymbLast_p = NULL;
  
}

/* ------------------------------------------------------------- */
/* find formula symbol with given name name_p */
/*                                                               */
/* the result of search will be in tree node pointer ArrayTree_p */

Symbol *
find_formula_id(name_p) char *name_p;       
{
  TreeNode_t *t;
  int         result;

  if (FormulaTree_p == NULL) {  /* a new tree, should not happen!! */
      return (NULL);
  }
  t = t_splay(name_p, FormulaTree_p);
  result = comp_namesymbol(name_p,t->t_sp) ;
  if( result == 0 ) {
    FormulaTree_p = t;     /* we have found the tree node */
    return (FormulaTree_p->t_sp);
  } else { /* either result < 0 or result > 0 , Should not happen!! */
    return (NULL);
  }
}

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





/* -------------------------- main entry point for formula parser -------------- */
/* evaulate formula string */
/*   (which consists of user input and answer formula) */
/* the formula string is of the form:: (answer formula) - (input formula) */
/* so that the difference could be calculated */
/* then the tolerence is compared with the absolute value of */
/*    difference to see if it was satisfied */
/* RETURN:   0 no error */
/*           1 error    */
int
f_eval_formula(f_val, f_str, v_str, pt_str) double *f_val;char *f_str;char *v_str; char *pt_str;
{
  int  no_error;
  
  /* before setup formula symbol tree, make sure it is clean */
  
  no_error = setup_formula_id(v_str,pt_str);
  /* printf("\nSETUP formula ID (%s),(%s) returned %d\n",v_str,pt_str,no_error); */
  /* copy the formula into lexer buffer */
  if( no_error ) {
    strcpy(Fbuf,f_str);
    Fidx = 0;
    FormulaParseOK = 1;
    fml_parse(); /* main entry point */
    if( FormulaParseOK ) {
      *f_val = FormulaVal;
      /* printf("\nEVAL formulaOK = (%.16g)\n",FormulaVal); */
      return (0);
    }
  }
  return (1);
}

int
f_u_parse_formula(f_str) char *f_str;
{
  strcpy(Fbuf,f_str);
  Fidx = 0;
  fml_parse();
  printf("[%s]=%.16g\n",f_str,FormulaVal);
  return (0);
}


/* ----------------------------------------------------------------------------- */
/*   converts a string of the form "123.4,56.8,9.0,9" into an array of doubles   */
/*   Usage: double   *f_a; cnt = f_str_to_numbers(&f_a, in_buf);
     printf(" [%.16g] ",f_a[i] );
*/
int  f_str_to_numbers(f_ar, n_str) double **f_ar; char *n_str;
{
  int        leng, n_cnt = 0, comma_cnt=0, not_done, i, j;
  char       num_str[QUARTER_K];
  double     tmp_farray[ONE_K];
  double    *f_array;
  
  
  leng = strlen(n_str);
  if( leng > 0 ) {
    for( i=0; i<leng;i++) {
      if( n_str[i] == ',' ) {
        comma_cnt++;
      }
    }
  } else {
    return (0);
  }
  if( comma_cnt >= 0 ) {
    i=0;
    not_done = 1;
    while( not_done ) {
      j=0;
      while( isspace(n_str[i]) || n_str[i] == ',' ) { i++; }
      if( n_str[i] == '+' || n_str[i] == '-' ) {
         num_str[j++] = n_str[i++];
      }
      while( isdigit(n_str[i]) || n_str[i] == '.' ) {
        num_str[j++] = n_str[i++];
      }
      if( n_str[i] == 'E' || n_str[i] == 'e' ) {
        if( n_str[i+1] == '+' || n_str[i+1] == '-' || isdigit(n_str[i+1]) ) {
          num_str[j++] = n_str[i++];
          num_str[j++] = n_str[i++];
          while( isdigit(n_str[i]) ) {
            num_str[j++] = n_str[i++];
          }
        }
      }
      num_str[j] = 0;
      tmp_farray[n_cnt] = strtod(num_str,(char **)0);
      n_cnt++;
      if( (i >= leng) || (n_cnt == (comma_cnt+1)) ) { not_done = 0; }
    }
    f_array = (double *)capa_malloc(comma_cnt+1, sizeof(double));
    for(i=0;i<=comma_cnt;i++) {
      f_array[i] = tmp_farray[i];
    }
  }
  *f_ar = f_array;
  return ( n_cnt );
}

/* splits input string "abc, v345_9, pqr" into individual variables */
   
int  f_str_to_ids(v_ar, n_str) char ***v_ar; char *n_str;
{
  int        leng, v_len, n_cnt = 0, comma_cnt=0, not_done, i, j;
  char       v_str[ONE_K];
  char     **tmp_array;
  
  leng = strlen(n_str);
  if( leng > 0 ) {
    for( i=0; i<leng;i++) {
      if( n_str[i] == ',' ) {
        comma_cnt++;
      }
    }
  } else {
    return (0);
  }
  if( comma_cnt >= 0 ) {
    tmp_array = (char **)capa_malloc((comma_cnt+1), sizeof(char *));
    i=0;
    not_done = 1;
    while( not_done ) {
      j=0;
      while( isspace(n_str[i]) || n_str[i] == ',' ) { i++; }
      if( isalpha( n_str[i] ) ) {
         v_str[j++] = n_str[i++];
      }
      while( isalnum(n_str[i]) || n_str[i] == '_' ) {
        v_str[j++] = n_str[i++];
      }
      v_str[j] = 0;
      v_len = strlen(v_str);
      tmp_array[n_cnt] = (char *)capa_malloc((v_len+1),sizeof(char));
      strcpy(tmp_array[n_cnt], v_str);
      n_cnt++;
      if( (i >= leng) || (n_cnt == (comma_cnt+1)) ) { not_done = 0; }
    }
  }
  *v_ar = tmp_array;
  return ( n_cnt );
}

/* creates a linked list from the inputs such as "0.0,0.0" to "1.0,1.0" */

PointsList_t *
f_gen_pts_previously( ap, bp, n ) char *ap; char *bp; int n;
{
  PointsList_t  *pt_p, *tmp_p, *tail_p;
  int            cnt1, cnt2, i, j;
  double        *p1, *p2, cp, *dist, *delta;
  char           num_str[ONE_K], pt_str[TWO_K];
  char           warn_msg[WARN_MSG_LENGTH];
  
  pt_p = NULL;
  cnt1 = f_str_to_numbers(&p1, ap);
  cnt2 = f_str_to_numbers(&p2, bp);
  if( cnt1 == cnt2 ) { /* the number of dimensions must agrees */
    if( n > 0 ) {
      dist = (double *)capa_malloc(cnt1, sizeof(double));
      delta = (double *)capa_malloc(cnt1, sizeof(double));
      for(i=0;i<cnt1;i++) { /* the i-th dimension */
        dist[i] = p2[i] - p1[i];  /* dist[i] could be negative */
      }
      if( n > 1 ) { /* n >= 2 */
        for(i=0;i<cnt1;i++) {
          delta[i] = dist[i] / (double)(n-1.0);
        }
      } else {
        for(i=0;i<cnt1;i++) {
          delta[i] = dist[i] / 2.0;    /* delta[i] could be negative */
        }
      }
      for(j=0;j<n;j++) {  /* the j-th points */
          pt_str[0] = 0;
          for(i=0;i<cnt1;i++) {  /* the i-th dimension */
            cp = p1[i] + ((double)j)*delta[i];
            sprintf(num_str,"%.16g", cp);
            strcat(pt_str, num_str);
            if( i < (cnt1-1) ) {
              strcat(pt_str, ", ");
            }
          }
          
          tmp_p = (PointsList_t *)capa_malloc(1,sizeof(PointsList_t)); /* *** */
          tmp_p->pts_str   = strsave(pt_str);
          tmp_p->pts_idx   = j;
          tmp_p->pts_next  = NULL;
          if( j == 0 ) {
            pt_p = tmp_p; 
            tail_p = pt_p;
          } else {
            tail_p->pts_next = tmp_p;
            tail_p = tmp_p;
          }
       }
       capa_mfree((char *)dist);
       capa_mfree((char *)delta);
       capa_mfree((char *)p1);
       capa_mfree((char *)p2);
    } /* end n > 0 */
  } else { /* when cnt1 != cnt2 */
    sprintf(warn_msg,"Eval = <\"IDs\" @ pts : pts # N >, dimemsions of pts do not agreed.\n");
    capa_msg(MESSAGE_ERROR,warn_msg);
  }
  return (pt_p);

}


/* creates a linked list from the inputs such as "0.0,0.0" to "1.0,1.0" */
/* the coordinates of the generated points are randomly picked from the */
/* regions defined by the given two coordinates */
/* the selector for random number generator is FORMULA_PICK_POINTS */
/* the seed to the random number generator is *ap */
PointsList_t *
f_gen_pts( ap, bp, n ) char *ap; char *bp; int n;
{
  PointsList_t  *pt_p, *tmp_p, *tail_p;
  int            cnt1, cnt2, i, j;
  double        *p1, *p2, cp, *dist, *delta;
  char           num_str[ONE_K], pt_str[TWO_K];
  char           warn_msg[WARN_MSG_LENGTH];
  long           seed1, seed2, orig_gen, current_gen;
  
  pt_p = NULL;
  cnt1 = f_str_to_numbers(&p1, ap);
  cnt2 = f_str_to_numbers(&p2, bp);
  if( cnt1 == cnt2 ) { /* the number of dimensions must agrees */
    if( n > 0 ) { /* number of points must be positive */
      gscgn(GET_GENERATOR, &orig_gen);
      current_gen = (long)FORMULA_PICK_POINTS;
      gscgn(SET_GENERATOR, &current_gen);
      phrtsd(ap, &seed1, &seed2);
      setsd(seed1, seed2);
      /*  use float genunf(float low,float high) to generate the coordinate */
      for(j=0;j<n;j++) {  /* the j-th points */
          pt_str[0] = 0;
          for(i=0;i<cnt1;i++) {  /* the i-th dimension */
            if( p2[i] >= p1[i] ) {
              cp = genunf(p1[i],p2[i]);
            } else {
              cp = genunf(p2[i],p1[i]);
            }
            sprintf(num_str,"%.16g", cp);
            strcat(pt_str, num_str);
            if( i < (cnt1-1) ) {
              strcat(pt_str, ", ");
            }
          }
          /* allocate the space for newly generated coordinate */
          tmp_p = (PointsList_t *)capa_malloc(1,sizeof(PointsList_t)); /* *** */
          tmp_p->pts_str   = strsave(pt_str);
          tmp_p->pts_idx   = j;
          tmp_p->pts_next  = NULL;
          if( j == 0 ) {
            pt_p = tmp_p; 
            tail_p = pt_p;
          } else {
            tail_p->pts_next = tmp_p;
            tail_p = tmp_p;
          }
       }
       /* restore to the original random generator */
       gscgn(SET_GENERATOR, &orig_gen);
    } /* end n > 0 */
  } else { /* when cnt1 != cnt2 */
    sprintf(warn_msg,"Eval = <\"IDs\" @ pts : pts # N >, dimemsions of pts do not agreed.\n");
    capa_msg(MESSAGE_ERROR,warn_msg);
  }
  /* put things back in place, return memory spaces */
  capa_mfree((char *)p1);
  capa_mfree((char *)p2);
  return (pt_p);

}


PointsList_t *
gen_ptslist( ap, bp, np ) Symbol *ap; Symbol *bp; Symbol *np;
{
  PointsList_t *ptp;
  char          warn_msg[WARN_MSG_LENGTH];
  char         *p1, *p2;
  int           pts_cnt, error=0;
  
  ptp = NULL;
  switch( ap->s_type ) {
    case IDENTIFIER:
           sprintf(warn_msg,"Eval = <\"IDs\" @ pts : pts # N >, \" %s \" not defined before use.\n",
           ap->s_name);
           capa_msg(MESSAGE_ERROR,warn_msg);
           error=1;
           break;
    case I_VAR: case I_CONSTANT:
           sprintf(warn_msg,"Eval = <\"IDs\" @ %ld : pts # N >, cannot be a number.\n", ap->s_int);
           capa_msg(MESSAGE_ERROR,warn_msg);
           error=1;
           break;
    case R_VAR: case R_CONSTANT:
           sprintf(warn_msg,"Eval = <\"IDs\" @ %.16g : pts # N>, cannot be a number.\n", ap->s_real);
	   capa_msg(MESSAGE_ERROR,warn_msg);
	   error=1;
           break;
    case S_VAR: case S_CONSTANT:
           p1 = strsave(ap->s_str);
	   break;
  }
  switch( bp->s_type ) {
    case IDENTIFIER:
           sprintf(warn_msg,"Eval = <\"IDs\" @ pts : pts # N >, \" %s \" not defined before use.\n",
           bp->s_name);
           capa_msg(MESSAGE_ERROR,warn_msg); error=1;
           break;
    case I_VAR: case I_CONSTANT:
           sprintf(warn_msg,"Eval = <\"IDs\" @ pts : %ld# N >, cannot be a number.\n", bp->s_int);
           capa_msg(MESSAGE_ERROR,warn_msg); error=1;
           break;
    case R_VAR: case R_CONSTANT:
           sprintf(warn_msg,"Eval = <\"IDs\" @ pts : %.16g # N>, cannot be a number.\n",
           bp->s_real);
	   capa_msg(MESSAGE_ERROR,warn_msg); error=1;
           break;
    case S_VAR: case S_CONSTANT:
           p2 = strsave(bp->s_str);
	   break;
  }
  switch( np->s_type ) {
    case IDENTIFIER:
           sprintf(warn_msg,"Eval = <\"IDs\" @ pts : pts # %s >, not defined before use.\n",
           np->s_name);
           capa_msg(MESSAGE_ERROR,warn_msg); error=1;
           break;
    case I_VAR: case I_CONSTANT:
           pts_cnt = np->s_int;
           break;
    case R_VAR: case R_CONSTANT:
           sprintf(warn_msg,"Eval = <\"IDs\" @ pts : pts # %.16g >, cannot be a real number.\n",
           np->s_real);
	   capa_msg(MESSAGE_ERROR,warn_msg); error=1;
	   
	   pts_cnt = (int)floor(np->s_real);
           break;
    case S_VAR: case S_CONSTANT:
           sprintf(warn_msg,"Eval = <\"IDs\" @ pts : pts # %s >, cannot be a string.\n",
           np->s_str);
           capa_msg(MESSAGE_ERROR,warn_msg); error=1;
	   break;
  }
  if( error == 0 ) {
    ptp = f_gen_pts( p1, p2, pts_cnt );
  }
  return (ptp);
}


/*  ----------------------------------------------- */
/*  the input string could be of the form "0.0,0.0" or */
/*     "\"0.0,0.0\" : \"1.0,2.0\" # 5"  */

PointsList_t *
new_ptslist( sp ) Symbol *sp;
{
  PointsList_t *ptp;
  char          warn_msg[WARN_MSG_LENGTH];
  char         *colon, *pound;
  
  ptp = NULL;
  switch( sp->s_type ) {
    case IDENTIFIER:
           sprintf(warn_msg,"Eval = <\" IDs \" @ pts >, \" %s \" not defined before use.\n", sp->s_name);
           capa_msg(MESSAGE_ERROR,warn_msg);
           break;
    case I_VAR: case I_CONSTANT:
           sprintf(warn_msg,"Eval = <\" IDs \" @ %ld>, cannot be a number.\n", sp->s_int);
           capa_msg(MESSAGE_ERROR,warn_msg);
           break;
    case R_VAR: case R_CONSTANT:
           sprintf(warn_msg,"Eval = <\"IDs\" @ %.16g>, cannot be a number.\n", sp->s_real);
	   capa_msg(MESSAGE_ERROR,warn_msg);
           break;
    case S_VAR: case S_CONSTANT:
           colon = strchr(sp->s_str,':');
           pound = strchr(sp->s_str,'#');
           if( colon && pound ) {
             ptp = gen_ptslist_str(sp->s_str);
           } else {
             ptp = (PointsList_t *)capa_malloc(1,sizeof(PointsList_t)); /* *** */
             ptp->pts_str   = strsave(sp->s_str);
             ptp->pts_idx   = 1;
             ptp->pts_next  = NULL;
           }
	break;
  }  
  return (ptp);
}

PointsList_t *
gen_ptslist_str( range_str ) char *range_str;
{
  char         *colon, *pound, *cp;
  char          p1[ONE_K], p2[ONE_K], num[ONE_K];
  int           i, pts_cnt;
  PointsList_t *ptp;
  
  ptp = NULL;
  colon = strchr(range_str,':');
  pound = strchr(range_str,'#');
  if( (colon) && (pound)) { /* we must have both ':' and '#' */
    cp = range_str;
    i  = 0;
    while( isspace(*cp) || (*cp == '"') ) { cp++; }
    while( isdigit(*cp) || *cp == '-' || *cp == '.' || *cp == ',' || isspace(*cp) ) {
      p1[i++] =  *cp; cp++;
    }
    p1[i] = 0;
    while( isspace(*cp) || (*cp == '"') || (*cp == ':')) { cp++; }
    i = 0;
    while( isdigit(*cp) || *cp == '-' || *cp == '.' || *cp == ',' || isspace(*cp) ) {
      p2[i++] =  *cp; cp++;
    }
    p2[i] = 0;
    while( isspace(*cp) || (*cp == '"') || (*cp == '#')) { cp++; }
    i = 0;
    while( isdigit(*cp) ) { 
      num[i++] =  *cp; cp++;
    }
    num[i]=0;
    pts_cnt = atoi(num);
    ptp = f_gen_pts( p1, p2, pts_cnt );
  } else { /* could be a string like \"0.0,0.1,0.2,0.3,0.4\" */
    i = 0;
    cp = range_str;
    while( isspace(*cp) || (*cp == '"') ) { cp++; }
    while( isdigit(*cp) || *cp =='-' || *cp == '.' || *cp == ',' || isspace(*cp) ) {
      p1[i++] =  *cp; cp++;
    }
    p1[i] = 0;
    ptp = (PointsList_t *)capa_malloc(1,sizeof(PointsList_t)); /* *** */
    ptp->pts_str   = strsave(p1);
    ptp->pts_idx   = 1;
    ptp->pts_next  = NULL;
  }
  return (ptp);
}

char *
eval_formula_range_str(f_str,var_list,range_str)char *f_str;char *var_list;char *range_str;
{
  PointsList_t       *pts_p, *pt, *next;
  int                 error_code, len;
  double              f_val;
  char                result_str[FOUR_K], tmp_str[FOUR_K];
  char               *output_p;
  char               *formula_str, *variable_str, *points_str;
  
  len = strlen(f_str);
  formula_str = (char *)capa_malloc((len+1),sizeof(char ));
  strcpy(formula_str,f_str);
  len = strlen(var_list);
  variable_str = (char *)capa_malloc((len+1),sizeof(char ));
  strcpy(variable_str,var_list);
  len = strlen(range_str);
  points_str = (char *)capa_malloc((len+1),sizeof(char ));
  strcpy(points_str,range_str);
  
  
  output_p = NULL;
  
  result_str[0]=0; tmp_str[0] = 0;
  pts_p = gen_ptslist_str( points_str );
  if( pts_p != NULL ) {
    for (pt=pts_p; pt!=NULL ; pt=next) {
      next=pt->pts_next;
      if (pt->pts_str != NULL) {
        error_code = f_eval_formula(&f_val, formula_str, variable_str, pt->pts_str);
        if( ! error_code ) {
          sprintf(tmp_str,"[(%s) => %.15g]",pt->pts_str,f_val);
          strcat(result_str, tmp_str);
        } else {
	  char    warn_msg[WARN_MSG_LENGTH];
	  sprintf(warn_msg,"Unable to parse formula: %s",f_str);
	  capa_msg(MESSAGE_ERROR,warn_msg);
	  break;
	}
      }
      if( next!=NULL ) {
        strcat(result_str, ", ");
      }
    }
    len = strlen(result_str);
    output_p = (char *)capa_malloc((len+1),sizeof(char));
    strcpy(output_p,result_str);
  }
  capa_mfree((char *)formula_str);
  capa_mfree((char *)variable_str);
  capa_mfree((char *)points_str);
  
  return (output_p);
}

/* ----------------------------------------------------------------- */
void
free_ptslist( pts_p ) PointsList_t *pts_p;
{
  PointsList_t *p, *next;
  
  for (p=pts_p; p!=NULL ; p=next) {
      next=p->pts_next;
      if (p->pts_str != NULL) capa_mfree(p->pts_str);
      capa_mfree((char *)p);
  }
  
}

/* =||>>===================================================================<<||= */
/*                       end of capaParserUtils.c                                */
/* =||>>===================================================================<<||= */



