# include "rag.hh"
# include "nodes.h"
# include "grc.h"

IAT* grnl= NULL;

# include "swbus.h"
TNODE* temp;
TNODE* temp2;
TATTR* att;
# define outclass(nd, pos) {nd->value1= (CLR_TYPE)((int)nd->value1 & (~(1<< (pos - 1))));}

/* KJT 20/01/23: added function prototypes */

int unlink(const char *pathname);

PRIVATE void
PROCESINI (r)
    TNODE* r;
{
  TNODE* h[33];
  /* KJT 20/01/23: added "int" type */
  register int i;
  int nr;
  int* grl;

  while (r != NULL) {
    h[0]= r;
    heval (r, h);
    grl= grnl->data[(int)(r->value0)];
    for (i= 0; grl[i] != 0; i++) {
     nr= grl[i];
     switch (nr) {
      case _specification_1:
	 adclr (-c_preserve, h[3], 1);
	 adclr (-c_vclrs, h[3], 2);
	 adclr (-c_preserve, h[6], 3);
	 adclr (-c_vclrs, h[6], 4);
	 break;
      case _sort_id_comm_1:
	 adclr (-c_vclrs, h[2], 5);
	 break;
      case _operation_descriptor_1:
	 adclr (-c_vclrs, h[2], 6);
	 break;
      case _operation_descriptor_2:
	 adclr (-c_vclrs, h[2], 7);
	 break;
      case _equation_3:
	 adclr (-c_tree, h[0], 8);
	 break;
      case _implicit_true_1:
	 adclr (-c_tree, h[0], 9);
	 break;
      case _action_prefix_expression_1:
	 adclr (-c_preserve, h[1], 10);
	 adclr (-c_vclrs, h[1], 11);
	 break;
      case _action_denotation_1:
	 adclr (-c_preserve, h[2], 12);
	 adclr (-c_vclrs, h[2], 13);
	 break;
      case _action_denotation_2:
	 adclr (-c_preserve, h[4], 14);
	 adclr (-c_vclrs, h[4], 15);
	 break;
      case _action_denotation_3:
	 adclr (-c_preserve, h[1], 16);
	 adclr (-c_vclrs, h[1], 17);
	 break;
      case _atomic_expression_2:
	 if (h[1] != NULL)
	  adclr (-c_preserve, h[1], 18);
	 if (h[1] != NULL)
	  adclr (-c_vclrs, h[1], 19);
	 break;
      case _atomic_expression_3:
	 adclr (-c_preserve, h[1], 20);
	 adclr (-c_vclrs, h[1], 21);
	 break;
      case _process_instantiation_1:
	 if (h[1] != NULL)
	  adclr (-c_preserve, h[1], 22);
	 if (h[1] != NULL)
	  adclr (-c_vclrs, h[1], 23);
	 break;
      case _value_expression_1:
	 if (h[0] != NULL)
	  adclr (-c_paren, h[0], 24);
	 if (h[1] != NULL)
	  adclr (-c_ofsort, h[1], 25);
	 if (h[0] != NULL)
	  adclr (-c_tree, h[0], 26);
	 break;
      case _value_expression_2:
	 if (h[0] != NULL)
	  adclr (-c_lexv, h[0], 27);
	 if (h[0] != NULL)
	  adclr (-c_line, h[0], 28);
	 if (h[0] != NULL)
	  adclr (-c_paren, h[0], 29);
	 if (h[0] != NULL)
	  adclr (-c_infix, h[0], 30);
	 if (h[3] != NULL)
	  adclr (-c_ofsort, h[3], 31);
	 if (h[0] != NULL)
	  adclr (-c_tree, h[0], 32);
	 break;
      case _term_expression_1:
	 if (h[0] != NULL)
	  adclr (-c_lexv, h[0], 33);
	 if (h[0] != NULL)
	  adclr (-c_line, h[0], 34);
	 if (h[0] != NULL)
	  adclr (-c_paren, h[0], 35);
	 if (h[0] != NULL)
	  adclr (-c_tree, h[0], 36);
	 break;
      case _term_expression_2:
	 adclr (-c_paren, h[0], 37);
	 adclr (-c_tree, h[0], 38);
	 break;
      case _value_expression_list_1:
	 if (h[0] != NULL)
	  adclr (-c_troo, h[0], 39);
	 break;
      case _identifier_1:
	 adclr (-c_preserve, h[1], 40);
	 adclr (-c_vclrs, h[1], 41);
	 break;
      case _executable_comment_list_1:
	 h[3]= h[1];
	 h[4]= gt_rb (h[3]);
	 while (h[3] != NULL) {
	  adclr (-c_vclrs, h[3], 42);
	  h[3]= h[4];
	  h[4]= gt_rb (h[4]);
	 }
	 if (h[0] != NULL)
	  adclr (-c_keylist, h[0], 43);
	 if (h[0] != NULL)
	  adclr (-c_vallist, h[0], 44);
	 break;
      case _excomm_1:
	 break;
      default:
	 assert ((1 <= nr) && (nr <= LAST_RULE));
      }
    } /* end of while (ngr != NULL) */
    r= succ (r, PREORDER);
  } /* end of while (r != NULL) */
} /* end of PROCESINI */

PRIVATE void
PROCES0 (r)
    TNODE* r;
{
  TNODE* h[33];
  int nr;
  /* KJT 20/01/23: added "int" type */
  register int i;
  int* grl;

  while (r != NULL) {
    h[0]= r;
    heval (r, h);
    grl= grnl->data[(int)(r->value0)];
    for (i= 0; grl[i] != 0; i++) {
      nr= grl[i];
      switch (nr) {
      case _excomm_1:
	(void) eval (45, r);
	 break;
      default:
	 assert ((1 <= nr) && (nr <= LAST_RULE));
      }
    } /* end of while (ngr != NULL) */
    r= succ (r, PREORDER);
  } /* end of while (r != NULL) */
} /* end of PROCES0 */

PUBLIC CLR_TYPE
eval (nar, r)
    int nar;
    TNODE* r;
{
  TNODE* h[33];

  if (r == NULL) return (CLR_TYPE)NULL;
  switch (nar) {
  case 1:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 0;
  case 2:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE)
	INTcons (c_lbc,
	INTcons (c_ldc,
	INTcons (c_ldcinit,
	INTcons (c_implby,
	INTcons (c_initSby,
	INTcons (c_initZby,
	nil (INTlist)))))));
  case 3:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 0;
  case 4:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE)
	INTcons (c_lbc,
	INTcons (c_ldc,
	 nil (INTlist)));
  case 5:
    h[0]= gt_ft (r);
    heval (h[0], h);

      return (CLR_TYPE) INTcons (c_copy,
	INTcons (c_draw,
	INTcons (c_equal,
	INTcons (c_extern,
	INTcons (c_free,
	INTcons (c_name,
	INTcons (c_nocopy,
	INTcons (c_nodraw,
	INTcons (c_nofree,
	INTcons (c_noparse,
	INTcons (c_parse,
	INTcons (c_type,
	nil (INTlist)))))))))))));
  case 6:
    h[0]= gt_ft (r);
    heval (h[0], h);

      return (CLR_TYPE) INTcons (c_extern,
	INTcons (c_name,
	INTcons (c_partial,
	INTcons (c_internal,
	INTcons (c_lexical,
	INTcons (c_lexicalifpossible,
	INTcons (c_using,
	INTcons (c_usingsort,
	INTcons (c_constructor,
	INTcons (c_nonconstructor,
	INTcons (c_call,
	nil (INTlist))))))))))));
  case 7:
    h[0]= gt_ft (r);
    heval (h[0], h);

      return (CLR_TYPE) INTcons (c_extern,
	INTcons (c_name,
	INTcons (c_partial,
	INTcons (c_internal,
	INTcons (c_lexical,
	INTcons (c_lexicalifpossible,
	INTcons (c_using,
	INTcons (c_usingsort,
	INTcons (c_constructor,
	INTcons (c_nonconstructor,
	INTcons (c_call,
	nil (INTlist))))))))))));
  case 8:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) NULL;
  case 9:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE)
     simple_eq (h[0], (TNODE*)fdclr (c_tree,h[1], nar));
  case 10:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 1;
  case 11:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) INTcons (c_delay,
		      INTcons (c_wait,
		      INTcons (c_priority,
		      INTcons (c_if,
		      nil (INTlist))))) ;
  case 12:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 2;
  case 13:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) INTcons (c_c, nil (INTlist));
  case 14:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 2;
  case 15:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) INTcons (c_c, nil (INTlist));
  case 16:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 2;
  case 17:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) INTcons (c_c, nil (INTlist));
  case 18:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 1;
  case 19:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) INTcons (c_delay,
		      INTcons (c_wait,
		      INTcons (c_priority,
		      INTcons (c_if,
		      nil (INTlist))))) ;
  case 20:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 1;
  case 21:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) INTcons (c_delay,
		      INTcons (c_wait,
		      INTcons (c_priority,
		      INTcons (c_if,
		      nil (INTlist))))) ;
  case 22:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 1;
  case 23:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) INTcons (c_delay,
		      INTcons (c_wait,
		      INTcons (c_priority,
		      INTcons (c_if,
		      nil (INTlist))))) ;
  case 24:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_paren,h[1], nar);
  case 25:
    h[0]= gt_ft (r);
    heval (h[0], h);
  if (h[2] != NULL)
				    return (CLR_TYPE) fdclr (c_lexv,h[2], nar);
			       else  return (CLR_TYPE) -1;
  case 26:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE)
     tv1 ((TNODE*) h[0],
	 (TNODE*) fdclr (c_tree,h[1], nar));
  case 27:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_lexv,h[2], nar);
  case 28:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_line,h[2], nar);
  case 29:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) 0;
  case 30:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) 0;
  case 31:
    h[0]= gt_ft (r);
    heval (h[0], h);
  if (h[4] != NULL)
				    return (CLR_TYPE) fdclr (c_lexv,h[4], nar);
			       else  return (CLR_TYPE) -1;
  case 32:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE)
     tv2 (h[0],
	 (TNODE*) fdclr (c_tree,h[1], nar),
	 (TNODE*) fdclr (c_tree,h[3], nar),
	 (int) fdclr (c_lexv,h[0], nar),
	 (int*) fdclr (c_line,h[0], nar),
	 (int) fdclr (c_infix,h[0], nar));
  case 33:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_lexv,h[1], nar);
  case 34:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_line,h[1], nar);
  case 35:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) 0;
  case 36:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE)
      ((h[2] == NULL)
      ? tt1 (h[0],
	    (int) fdclr (c_lexv,h[0], nar),
	    (int*) fdclr (c_line,h[0], nar),
	    (int) fdclr (c_ofsort,h[0], nar))
      : tt2 (h[0],
	    (TNODE*) fdclr (c_troo,h[2], nar),
	    (int) fdclr (c_lexv,h[0], nar),
	    (int*) fdclr (c_line,h[0], nar),
	    (int) fdclr (c_ofsort,h[0], nar)));
  case 37:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) ((int)fdclr (c_paren,h[1], nar) + 1);
  case 38:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE)
    tt3 ((TNODE*) fdclr (c_tree,h[1], nar),
	(int) fdclr (c_paren,h[0], nar),
	(int) fdclr (c_ofsort,h[0], nar));
  case 39:
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE) tvl1 (h[1]);
  case 40:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) 3;
  case 41:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) INTcons (c_default,
		     INTcons (c_use,
		     INTcons (c_eval,
		     nil (INTlist)))) ;
  case 42:
    h[0]= gt_ft (r);
    h[1]= gt_fs (h[0]);
    h[3]= r;
    h[4]= gt_rb (h[3]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE) fdclr (c_vclrs,h[0], nar);
  case 43:
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
  {
	INTlist	keyl;
	TNODE*	nd;
	keyl= nil (INTlist);
	for (nd= gt_fs(h[0]); nd != NULL; nd= nd->brothers) {
	 switch (name2clr((char*) fdclr(c_ckey, nd, -1))->atype) {
	 case c_constructor:
	 case c_extern:
	 case c_internal:
	 case c_lexical:
	 case c_lexicalifpossible:
	 case c_nocopy:
	 case c_nodraw:
	 case c_nofree:
	 case c_nonconstructor:
	 case c_noparse:
	 case c_usingsort:
	   check_empty (nd);
	   break;
	 case c_c:
	 case c_call:
	 case c_default:
	 case c_delay:
	 case c_eval:
	 case c_if:
	 case c_implby:
	 case c_initSby:
	 case c_initZby:
	 case c_lbc:
	 case c_ldc:
	 case c_ldcinit:
	 case c_partial:
	 case c_priority:
	 case c_type:
	 case c_use:
	 case c_wait:
	   check_nonempty (nd);
	   break;
	 case c_copy:
	 case c_draw:
	 case c_equal:
	 case c_free:
	 case c_name:
	 case c_using:
	 case c_parse:
	   check_one_word (nd);
	   break;
	 default:
	   break;
	 }
	 keyl= INTcons (name2clr((char*) fdclr(c_ckey, nd, -1))->atype,
			keyl);
	}
	 return (CLR_TYPE) keyl;
  }
  case 44:
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
  {
	STRlist	vall;
	TNODE*	nd;
	vall= nil (STRlist);
	for (nd= gt_fs(h[0]); nd != NULL; nd= nd->brothers)
	    vall= STRcons ((char*)fdclr(c_cval, nd, -1), vall, TRUE);
	 return (CLR_TYPE) vall;
  }
  case 45:
    h[0]= r;
    heval (h[0], h);
    if ( !(   validexc (name2clr((char*) fdclr (c_ckey,h[0], nar))->atype,
	    (INTlist) fdclr (c_vclrs,h[0], nar))
	)) {
     report (r, c_line);
     (void) fprintf (stderr, "invalid annotation %s\n", (char*)fdclr (c_ckey,h[0], nar)
	   );
  }
  return NULL;
     }
  return (CLR_TYPE)NULL;
}






PUBLIC void
visit (r)
	TNODE*	r;
{
	TNODE*	h[33];
	int	nar;

  if (r == NULL) return;
  nar= *(grnl->data[(int)(r->value0)]);
  switch (nar) {

   case _specification_1 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[3]->sons == NULL) {
	 cut_tree(h[3]);
	 outclass(h[0], 3);
	 }
	 if (h[6]->sons == NULL) {
	 cut_tree(h[6]);
	 outclass(h[0], 6);
	 }
	}
	break;

   case _sort_id_comm_1 :
    h[0]= r;
    heval (h[0], h);
	{
	 putexc (h[1], h[2]);
	 cut_tree(h[2]);
	 outclass(h[0], 2);
	}
	break;

   case _operation_descriptor_1 :
    h[0]= r;
    heval (h[0], h);
	{
	 putexc (h[1], h[2]);
	 cut_tree(h[2]);
	 outclass(h[0], 2);
	}
	break;

   case _operation_descriptor_2 :
    h[0]= r;
    heval (h[0], h);
	{
	 putexc (h[1], h[2]);
	 cut_tree(h[2]);
	 outclass(h[0], 2);
	}
	break;

   case _action_prefix_expression_1 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[1]->sons == NULL) {
	 cut_tree(h[1]);
	 outclass(h[0], 1);
	 }
	}
	break;

   case _action_denotation_1 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[2]->sons == NULL) {
	 cut_tree(h[2]);
	 outclass(h[0], 2);
	 }
	}
	break;

   case _action_denotation_2 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[4]->sons == NULL) {
	 cut_tree(h[4]);
	 outclass(h[0], 4);
	 }
	}
	break;

   case _action_denotation_3 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[1]->sons == NULL) {
	 cut_tree(h[1]);
	 outclass(h[0], 1);
	 }
	}
	break;

   case _atomic_expression_2 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[1]->sons == NULL) {
	 cut_tree(h[1]);
	 outclass(h[0], 1);
	 }
	}
	break;

   case _atomic_expression_3 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[1]->sons == NULL) {
	 cut_tree(h[1]);
	 outclass(h[0], 1);
	 }
	}
	break;

   case _process_instantiation_1 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[1]->sons == NULL) {
	 cut_tree(h[1]);
	 outclass(h[0], 1);
	 }
	}
	break;

   case _identifier_1 :
    h[0]= r;
    heval (h[0], h);
	{
	 if (h[1]->sons == NULL) {
	 cut_tree(h[1]);
	 outclass(h[0], 1);
	 }
	}
	break;

   case _executable_comment_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
	{
	 TNODE* nd;
	 if (find_attr (c_preserve, h[0]) != NULL) {
	 for (nd= gt_fs(h[0]); nd != NULL; nd= nd->brothers)
	 set_attr (name2clr((char*) fdclr(c_ckey, nd, -1))->atype,
	 nd,
	 fdclr(c_cval, nd, -1));
	 switch ((int) fdclr (c_preserve,h[0], nar)) {
	 case 1:
	 excheck1 (gt_fs(h[0]));
	 break;
	 case 2:
	 excheck2 (gt_fs(h[0]));
	 break;
	 case 3:
	 excheck3 (gt_fs(h[0]));
	 break;
	 }
	 }
	}
	break;
  }
}

PUBLIC void
rag (r)
    TNODE* r;
{
  PROCESINI (r);
  PROCES0 (r);
  if (ragerrors == 0)
    todo (r);
} /* end of rag */
