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

IAT* grnl= NULL;

#include "elib.h"
#include "scopes.h"
#include "sets.h"

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:
	 if (h[1] != NULL)
	  adclr (-c_scopein, h[1], 1);
	 h[3]= h[1];
	 h[4]= gt_rb (h[3]);
	 while (h[4] != NULL) {
	  adclr (-c_scopein, h[4], 2);
	  h[3]= h[4];
	  h[4]= gt_rb (h[4]);
	 }
	 break;
      case _object_1:
	 adclr (-c_scopein, h[1], 3);
	 adclr (-c_scopeout, h[0], 4);
	 break;
      case _object_2:
	 adclr (-c_scope, h[1], 5);
	 adclr (-c_scopeout, h[0], 6);
	 break;
      case _definition_1:
	 adclr (-c_scopein, h[1], 7);
	 adclr (-c_scope, h[2], 8);
	 adclr (-c_set, h[1], 9);
	 adclr (-c_scopeout, h[0], 10);
	 break;
      case _test_case_block_1:
	 adclr (-c_scope, h[1], 11);
	 adclr (-c_ldefs, h[1], 12);
	 break;
      case _test_case_block_2:
	 if (h[1] != NULL)
	  adclr (-c_scopein, h[1], 13);
	 if (h[2] != NULL)
	  adclr (-c_scope, h[2], 14);
	 if (h[2] != NULL)
	  adclr (-c_ldefs, h[2], 15);
	 break;
      case _local_definition_list_1:
	 if (h[1] != NULL)
	  adclr (-c_scopein, h[1], 16);
	 h[3]= h[1];
	 h[4]= gt_rb (h[3]);
	 while (h[4] != NULL) {
	  adclr (-c_scopein, h[4], 17);
	  h[3]= h[4];
	  h[4]= gt_rb (h[4]);
	 }
	 if (h[0] != NULL)
	  adclr (-c_scopeout, h[0], 18);
	 if (h[0] != NULL)
	  adclr (-c_ldefs, h[0], 19);
	 break;
      case _local_definition_1:
	 adclr (-c_scopein, h[1], 20);
	 adclr (-c_scope, h[2], 21);
	 adclr (-c_set, h[1], 22);
	 adclr (-c_scopeout, h[0], 23);
	 adclr (-c_ldefs, h[0], 24);
	 break;
      case _local_definition_2:
	 adclr (-c_scopein, h[1], 25);
	 adclr (-c_scope, h[2], 26);
	 adclr (-c_set, h[1], 27);
	 adclr (-c_scopeout, h[0], 28);
	 adclr (-c_ldefs, h[0], 29);
	 break;
      case _matrix_1:
	 adclr (-c_scopeout, h[0], 30);
	 adclr (-c_ldefs, h[0], 31);
	 break;
      case _test_case_list_1:
	 h[3]= h[1];
	 h[4]= gt_rb (h[3]);
	 while (h[3] != NULL) {
	  adclr (-c_ldefs, h[3], 33);
	  h[3]= h[4];
	  h[4]= gt_rb (h[4]);
	 }
	 h[3]= h[1];
	 h[4]= gt_rb (h[3]);
	 while (h[3] != NULL) {
	  adclr (-c_scope, h[3], 34);
	  h[3]= h[4];
	  h[4]= gt_rb (h[4]);
	 }
	 break;
      case _test_case_1:
	 adclr (-c_ldefs, h[1], 35);
	 adclr (-c_scope, h[1], 36);
	 break;
      case _test_case_2:
	 adclr (-c_ldefs, h[1], 37);
	 adclr (-c_ldefs, h[2], 38);
	 adclr (-c_scope, h[2], 39);
	 break;
      case _set_declaration_list_1:
	 h[3]= h[1];
	 h[4]= gt_rb (h[3]);
	 while (h[3] != NULL) {
	  adclr (-c_scope, h[3], 40);
	  h[3]= h[4];
	  h[4]= gt_rb (h[4]);
	 }
	 if (h[0] != NULL)
	  adclr (-c_set, h[0], 41);
	 break;
      case _set_declaration_1:
	 if (h[0] != NULL)
	  adclr (-c_set, h[0], 42);
	 break;
      case _set_declaration_2:
	 adclr (-c_set, h[0], 43);
	 break;
      case _identifier_declaration_1:
	 adclr (-c_scopein, h[1], 45);
	 adclr (-c_set, h[1], 46);
	 adclr (-c_decl, h[1], 47);
	 adclr (-c_scopeout, h[0], 48);
	 adclr (-c_ldefs, h[0], 49);
	 break;
      case _identifier_declaration_list_1:
	 if (h[0] != NULL)
	  adclr (-c_scopeout, h[0], 50);
	 if (h[0] != NULL)
	  adclr (-c_ldefs, h[0], 51);
	 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 _matrix_1:
	(void) eval (32, r);
	 break;
      case _set_declaration_2:
	(void) eval (44, 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);
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE) NULL ;
  case 2:
    h[0]= gt_ft (r);
    h[1]= gt_fs (h[0]);
    h[4]= r;
    h[3]= gt_lb (h[4]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE) fdclr (c_scopeout,h[3], nar) ;
  case 3:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 4:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopeout,h[1], nar) ;
  case 5:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 6:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 7:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 8:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 9:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_set,h[2], nar) ;
  case 10:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopeout,h[1], nar) ;
  case 11:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scope,h[0], nar) ;
  case 12:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) NULL ;
  case 13:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scope,h[0], nar) ;
  case 14:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopeout,h[1], nar) ;
  case 15:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_ldefs,h[1], nar) ;
  case 16:
    h[0]= gt_ft (r);
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 17:
    h[0]= gt_ft (r);
    h[1]= gt_fs (h[0]);
    h[4]= r;
    h[3]= gt_lb (h[4]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE) fdclr (c_scopeout,h[3], nar) ;
  case 18:
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE)  fdclr (c_scopeout,h[5], nar) ;
  case 19:
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);

  {
       TNODE* nd;
       STRlist idl;
       idl= NULL;
       for (nd= h[1]; nd != NULL; nd= nd->brothers)
	idl= STRappend ((STRlist) fdclr (c_ldefs, nd, -11), idl, TRUE);
	return (CLR_TYPE) idl;
  }
  case 20:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 21:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 22:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_set,h[2], nar) ;
  case 23:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopeout,h[1], nar) ;
  case 24:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_ldefs,h[1], nar) ;
  case 25:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 26:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 27:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_set,h[2], nar) ;
  case 28:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopeout,h[1], nar) ;
  case 29:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_ldefs,h[1], nar) ;
  case 30:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE)
     install (install ((scope*)fdclr (c_scopein,h[0], nar), l2s (fdclr (c_lexv,h[1], nar)), l2s (fdclr (c_lexv,h[4], nar)),
		      (TNODE*) fdclr (c_set,h[0], nar)),
	     l2s (fdclr (c_lexv,h[3], nar)), l2s (fdclr (c_lexv,h[4], nar)), (TNODE*) fdclr (c_set,h[0], nar)) ;
  case 31:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) STRcons (l2s (fdclr (c_lexv,h[1], nar)),
		     STRcons (l2s (fdclr (c_lexv,h[2], nar)),
		     STRcons (l2s (fdclr (c_lexv,h[3], nar)), (STRlist) NULL,
		     TRUE), TRUE), TRUE) ;
  case 32:
    h[0]= r;
    heval (h[0], h);
    if ( !(   checkmatrix (l2s (fdclr (c_lexv,h[2], nar)))
	)) {
     report (r, c_line);
     (void) fprintf (stderr, "invalid matrix relation: '%s'\n", l2s (fdclr (c_lexv,h[2], nar))
	   );
  }
  return NULL;
  case 33:
    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_ldefs,h[0], nar) ;
  case 34:
    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_scope,h[0], nar) ;
  case 35:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_ldefs,h[0], nar) ;
  case 36:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scope,h[0], nar) ;
  case 37:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_ldefs,h[0], nar) ;
  case 38:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_ldefs,h[0], nar) ;
  case 39:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scope,h[0], nar) ;
  case 40:
    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_scope,h[0], nar) ;
  case 41:
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE) setunion (h[1]) ;
  case 42:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) h[1]->sons ;
  case 43:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) find ((scope*)fdclr (c_scope,h[0], nar), l2s (fdclr (c_lexv,h[1], nar))) ;
  case 44:
    h[0]= r;
    heval (h[0], h);
    if ( !(   fdclr (c_set,h[0], nar) != NULL
	)) {
     report (r, c_line);
     (void) fprintf (stderr, "undefined identifier: %s\n", l2s (fdclr (c_lexv,h[1], nar))
	   );
  }
  return NULL;
  case 45:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopein,h[0], nar) ;
  case 46:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_set,h[0], nar) ;
  case 47:
    h[0]= gt_ft (r);
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_lexv,h[2], nar) ;
  case 48:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_scopeout,h[1], nar) ;
  case 49:
    h[0]= r;
    heval (h[0], h);
   return (CLR_TYPE) fdclr (c_ldefs,h[1], nar) ;
  case 50:
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);

  {
       scope* scp;
       TNODE* nd;
       scp= (scope*) fdclr (c_scopein,h[0], nar);
       for (nd= h[1]; nd != NULL; nd= nd->brothers)
	scp= install (scp,
		      l2s (fdclr (c_lexv, nd, -12)),
		      l2s (fdclr (c_decl,h[0], nar)),
		      (TNODE*) fdclr (c_set,h[0], nar));
	return (CLR_TYPE) scp;
  }
  case 51:
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
   return (CLR_TYPE) STRcollect (h[1]) ;
     }
  return (CLR_TYPE)NULL;
}





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