/***********************************************************************
     "process.o": specific PROCESSing functions.
***********************************************************************/

/***********************************
  (C) Copyright 1992-1993; dit/upm
   Distributed under the conditions stated in the
   TOPO General Public License (see file LICENSE)
 ***********************************
 $Log: process.c,v $
 * Revision 1.5  1993/09/20  11:20:27  lotos
 * fix spelling of errors/warnings
 *
 * Revision 1.4  1993/06/10  13:56:52  lotos
 * new annotation CALL
 *
 * Revision 1.3  1993/03/29  18:14:34  lotos
 * new AST drawing
 * constructor checking
 * lexicalifpossible adapted to C and Ada intersection
 *
 * Revision 1.2  1993/03/24  17:45:23  lotos
 * new option -s
 * fixed an error when dealing with pattern ": -> any"
 * new annotations: nofree, nodraw, noparse
 * annotation partial accepts $$
 *
 * Revision 1.1  1993/03/18  11:14:24  lotos
 * Initial revision
 *
 ***********************************/

/* KJT 29/10/04: changed to use "stdarg" instead of "varargs" */

#include "version.h"
#ifndef lint
static char rcsid[]= "$Id: process.c,v 1.5 1993/09/20 11:20:27 lotos Exp $";
#endif

#define process_IMP

#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
#include <stdarg.h>
#include "glad.hh"
#include "support.hh"
#include "token.hh"
#include "process.hh"


PRIVATE void
SEMmsg (int miss, int idn, TNODE *nodep, char *msg, va_list args)
{
  static char miss_1_hdr[]= "%s(%d): ";
  static char warn_1_hdr[]= "%s(%d): warning: ";
  static char miss_2_hdr[]= "%s(%d), %s(%d): ";
  static char warn_2_hdr[]= "%s(%d), %s(%d): warning: ";

  if (nodep != NULL)
  { for (;;)
      if (t_leaf(nodep))
	break;
      else
	nodep= gt_fs(nodep);
  }
  if (idn >= 0)
    if (nodep != NULL &&
	ask_grn(nodep) >= 0)
      varargs_error(start_error, miss? miss_2_hdr: warn_2_hdr,
		    AT_nofile(idn), AT_noline(idn),
		    nofile(nodep), noline(nodep));
    else
      varargs_error(start_error, miss? miss_1_hdr: warn_1_hdr,
		    AT_nofile(idn), AT_noline(idn));
  else
    if (nodep != NULL)
      varargs_error(start_error, miss? miss_1_hdr: warn_1_hdr,
		    nofile(nodep), noline(nodep));
    else
      abort_if(TRUE)
  complete_error(msg, args);
}

PUBLIC void
SEMwarn (int idn, TNODE *nodep, char *msg, ...)
{
  va_list args;

  va_start(args, msg);
  SEMmsg(FALSE, idn, nodep, msg, args);
  va_end(args);
}

PUBLIC void
SEMmiss (int idn, TNODE *nodep, char *msg, ...)
{
  va_list args;

  va_start(args, msg);
  SEMmsg(TRUE, idn, nodep, msg, args);
  ++ragerrors;
  va_end(args);
}

PUBLIC void
SEMinfo (char *msg, ...)
{
  va_list args;

  va_start(args, msg);
  explain_error(msg, args);
  va_end(args);
}

/* loads the specification */

PRIVATE int
load_spec ()
{
  abort_if(SpecTree != NULL)
  SpecTree= restore(stdin);
  abort_if(SpecTree == NULL)
  abort_if(is_stbl_init(SymbolTable))
  SymbolTable= ask_ll(SpecTree);
  abort_if(!is_stbl_init(SymbolTable))
  SymbolTable->incr= 0;
  SymbolTable->class= 1;
  SymbolTable->ecase= FALSE;
  type2clr(c_ll)->free= NULL;
  type2clr(c_ll)->cpy= NULL;
  abort_if(is_stbl_init(ATable))
  ATable= ask_at(SpecTree);
  abort_if(!is_stbl_init(ATable))
  return 0;
}

/* adapts the specification for some obscure reasons */

PRIVATE int
adapt_spec ()
{
  int entry;
  TATTR *attrp;
  int key;
  int spec= -1, endspec;
  int sort_max= 0, opn_max= 0;
  int sort_cnt= 0, opn_cnt= 0;
  AT *CTable= NULL;
  int type;
  int where;

  abort_if(SpecTree == NULL)
  /* find and count declarations in ATable */
  for (entry= 0; entry < stbl_size(ATable); ++entry)
    switch ((int) stbl_entry(ATable, entry)->value0)
    { case spec_id:
	abort_if(spec >= 0)
	spec= entry;
	break;
      case sort_id:
	attrp= ATfind(stbl_ptr(ATable), entry, c_cui);
	if (attrp == NULL) continue;
	key= (int) attrp->value;
	if (key > sort_max) sort_max= key;
	++sort_cnt;
	break;
      case opn_id:
	attrp= ATfind(stbl_ptr(ATable), entry, c_cui);
	if (attrp == NULL) continue;
	key= (int) attrp->value;
	if (key > opn_max) opn_max= key;
	++opn_cnt;
	break;
    }
  abort_if(sort_max != sort_cnt)
  ++sort_max;
  abort_if(opn_max != opn_cnt)
  ++opn_max;
  /* set c_cso and c_cop attributes */
  set_draw(c_cso, type2clr(c_cso)->put);
  type2clr(c_cso)->put= NULL;
  set_attr(c_cso, SpecTree, (CLR_TYPE) sort_max);
  set_draw(c_cop, type2clr(c_cop)->put);
  type2clr(c_cop)->put= NULL;
  set_attr(c_cop, SpecTree, (CLR_TYPE) opn_max);
  /* set c_spec attribute, adding an ATable entry if needed */
  if (spec < 0)
  { spec= ATinc(stbl_ptr(ATable));
    stbl_entry(ATable, spec)->value0= (CLR_TYPE) spec_id;
    stbl_entry(ATable, spec)->value1= (CLR_TYPE) -7007;
  }
  set_attr(c_spec, SpecTree, (CLR_TYPE) spec);
  /* set c_endspec attribute, adding an ATable entry */
  endspec= ATinc(stbl_ptr(ATable));
  stbl_entry(ATable, endspec)->value0= (CLR_TYPE) -spec_id;
  stbl_entry(ATable, endspec)->value1= (CLR_TYPE) -7007;
  set_attr(c_endspec, SpecTree, (CLR_TYPE) endspec);
  /* move CTable attributes to ATable */
  attrp= find_attr(c_ct, SpecTree);
  abort_if(attrp == NULL)
  CTable= (AT *) attrp->value;
  for (entry= 0; entry < stbl_size(CTable); ++entry)
  { switch ((int) stbl_entry(CTable, entry)->value0)
    { case 0: /* ldc (specification) */
	type= c_ldc;
	where= spec;
	break;
      case 1: /* ldc (endspec) */
	type= c_ldc;
	where= endspec;
	break;
      case 2: /* ldcinit (specification) */
	type= c_ldcinit;
	where= spec;
	break;
      default:
	abort_if(TRUE);
    }
    attrp= ATfind(stbl_ptr(CTable), entry, type);
    abort_if(attrp == NULL)
    ATset(stbl_ptr(ATable), where, type, attrp->value);
    if (ATfind(stbl_ptr(ATable), where, c_line) == NULL)
    { attrp= ATfind(stbl_ptr(CTable), entry, c_line);
      abort_if(attrp == NULL)
      ATset(stbl_ptr(ATable), where, c_line, attrp->value);
    }
  }
  return 0;
}

/* initializes the whole declaration set */

PRIVATE int
init_decl_set ()
{
  int entry;
  int spec, endspec;
  int all_cnt= 0;
  int sort_cnt= 0;
  int opn_cnt= 0;
  int item;
  int sort, opn;

  abort_if(SpecTree == NULL ||
	   SpecDecl.all != NULL)
  spec= ask_spec(SpecTree);
  endspec= ask_endspec(SpecTree);
  sort_cnt= ask_cso(SpecTree);
  opn_cnt= ask_cop(SpecTree);
  all_cnt= sort_cnt + opn_cnt + 1;
  talloc(SpecDecl.begin, 2);
  SpecDecl.begin[0]= spec;
  SpecDecl.begin[1]= -1;
  talloc(SpecDecl.end, 2);
  SpecDecl.end[0]= endspec;
  SpecDecl.end[1]= -1;
  talloc(SpecDecl.sort, sort_cnt);
  SpecDecl.sort[--sort_cnt]= -1;
  talloc(SpecDecl.opn, opn_cnt);
  SpecDecl.opn[--opn_cnt]= -1;
  talloc(SpecDecl.all, all_cnt);
  SpecDecl.all[--all_cnt]= -1;
  SpecDecl.all[0]= spec;
  SpecDecl.all[--all_cnt]= endspec;
  for (entry= stbl_size(ATable) - 1; entry >= 0; --entry)
  { switch (AT_ask_idclass(entry))
    { case sort_id:
	if (AT_ask_cui(entry) < 0)
	  continue;
	SpecDecl.sort[--sort_cnt]= entry;
	break;
      case opn_id:
	if (AT_ask_cui(entry) < 0)
	  continue;
	SpecDecl.opn[--opn_cnt]= entry;
	break;
      default:
	continue;
    }
    SpecDecl.all[--all_cnt]= entry;
  }
  abort_if(all_cnt != 1 ||
	   sort_cnt != 0 ||
	   opn_cnt != 0)
  abort_if(SpecDecl.all == NULL)
  for (item= 0; SpecDecl.sort[item] >= 0; ++item)
  { sort= SpecDecl.sort[item];
    AT_add_opns(sort, ITcreate(10, 10, 0));
  }
  for (item= 0; SpecDecl.opn[item] >= 0; ++item)
  { opn= SpecDecl.opn[item];
    sort= AT_ask_sort(opn);
    (void) ITadd(opn, AT_ask_opns(sort));
  }
  return 0;
}

/* initializes the whole annotation set */

PRIVATE int
init_annot_set ()
{
  int item;
  int entry;
  NDqueue accept;
  NDqueue reject;
  tANNOT *ant_ptr;
  TNODE *nodep;
  TATTR *attrp;
  int i;

  abort_if(SpecTree == NULL ||
	   SpecDecl.all == NULL)
  SEMclear();
  for (item= 0; SpecDecl.all[item] >= 0; ++item)
  { entry= SpecDecl.all[item];
    accept= NQcreate();
    reject= NQcreate();
    for (ant_ptr= annot_list(0); ant_ptr->name != NULL; ++ant_ptr)
    { attrp= ATtake(stbl_ptr(ATable), entry, ant_ptr->attr);
      if (attrp != NULL)
      { nodep= new_node(ant_ptr->node);
	add_line(nodep, AT_ask_line(entry));
	if ((char *) attrp->value != NULL)
	  add_antv(nodep, (char *) attrp->value);
	add_grn(nodep, -7007);
	free_attr(attrp);
	if (prog_flag.ign_extn &&
	    ant_ptr->class == EXTERNAL)
	  i= -1;
	else
	  for (i= 0; i < ant_ptr->group.size; ++i)
	  { if (ant_ptr->group.item[i]->node == ant_ptr->node)
	      continue;
	    if (NQfind(accept, ant_ptr->group.item[i]->node) != NULL)
	    { SEMmiss(-1, nodep, "annotation \"%s\" incompatible with \"%s\"",
		      ant_ptr->name, ant_ptr->group.item[i]->name);
	      break;
	    }
	  }
	if (i < ant_ptr->group.size)
	{ (void) NQadd(reject, nodep);
	  continue;
	}
	(void) NQadd(accept, nodep);
      }
    }
    AT_add_accept(entry, accept);
    AT_add_reject(entry, reject);
    AT_add_insert(entry, NQcreate());
  }
  return SEMcnt();
}

PUBLIC int
build_spec ()
{
  int errcnt= 0;

  if ((errcnt+= load_spec()) != 0 ||
      (errcnt+= adapt_spec()) != 0 ||
      (errcnt+= init_decl_set()) != 0 ||
      (errcnt+= init_annot_set()) != 0)
    ;
  return errcnt;
}

/* loads the template */

PRIVATE int
load_tplt ()
{
  stinit(5000);
  if (SpecTree == NULL)
  { abort_if(SymbolTable != NULL)
    SymbolTable= STcreate(100, 0, 1, FALSE);
  }
  abort_if(SymbolTable == NULL)
  HashTable= STHinit(SymbolTable, 5119);
  grnl= IATcreate(100, 10, 1);
  abort_if(TpltTree != NULL)
  TpltTree= bast();
  if (SYNcnt() != 0)
    return SYNcnt();
  abort_if(SYNcnt() != 0)
  abort_if(TpltTree == NULL)
  if (SpecTree == NULL)
  { set_attr(c_ll, TpltTree, (CLR_TYPE) SymbolTable);
    type2clr(c_ll)->free= NULL;
    type2clr(c_ll)->cpy= NULL;
  }
  else
  { abort_if(SpecTree->value0 != NULL)
    abort_if(SpecTree->value1 != NULL)
    copyattrs(TpltTree, SpecTree);
  }
  set_attr(c_grnl, TpltTree, (CLR_TYPE) grnl);
  return 0;
}

PUBLIC void
init_rule (rule)
  TNODE *rule;
{
  TNODE *nodep;
  NDqueue accept;
  tANNOT *ant_ptr;
  int i;

  abort_if(rule == NULL ||
	   rule->type != tinitial_rule &&
	   rule->type != tfinal_rule &&
	   rule->type != tsort_rule &&
	   rule->type != toperation_rule)
  nodep= gt_rb(gt_fs(rule));
  if (nodep == NULL)
    return;
  accept= NQcreate();
  for (nodep= gt_fs(nodep); nodep != NULL; nodep= gt_rb(nodep))
  { ant_ptr= annot_node(nodep->type);
    abort_if(ant_ptr->node != nodep->type)
    if (prog_flag.ign_extn &&
	ant_ptr->class == EXTERNAL)
      continue;
    if (NQfind(accept, ant_ptr->node) != NULL)
    { SEMmiss(-1, nodep, "annotation \"%s\" repeated", ant_ptr->name);
      continue;
    }
    if (ant_ptr->group.size == 0)
      continue;
    for (i= 0; i < ant_ptr->group.size; ++i)
    { if (ant_ptr->group.item[i]->node == ant_ptr->node)
	continue;
      if (NQfind(accept, ant_ptr->group.item[i]->node) != NULL)
      { SEMmiss(-1, nodep, "annotation \"%s\" incompatible with \"%s\"",
		ant_ptr->name, ant_ptr->group.item[i]->name);
	break;
      }
    }
    if (i < ant_ptr->group.size)
      continue;
    (void) NQadd(accept, nodep);
  }
  NQdestroy(accept);
}

/* initializes the whole rule set */

PRIVATE int
init_rule_set ()
{
  abort_if(TpltTree == NULL)
  SEMclear();
  rag(TpltTree);
  return SEMcnt();
}

PUBLIC int
build_tplt ()
{
  int errcnt= 0;

  if ((errcnt+= load_tplt()) != 0 ||
      (errcnt+= init_rule_set()) != 0)
    ;
  return errcnt;
}

PRIVATE void
print_begin (fp, entry)
  FILE *fp;
  int entry;
{
  abort_if(fp == NULL)
  abort_if(!is_stbl_entry(ATable, entry) ||
	   AT_ask_idclass(entry) != spec_id)
  (void) fprintf(fp, "specification");
}

PRIVATE void
print_sort (fp, entry)
  FILE *fp;
  int entry;
{
  abort_if(fp == NULL)
  abort_if(!is_stbl_entry(ATable, entry) ||
	   AT_ask_idclass(entry) != sort_id)
  (void) fprintf(fp, "%s", AT_ident(entry));
}

PRIVATE void
print_opn (fp, entry)
  FILE *fp;
  int entry;
{
  int sort;
  INTlist sort_list;

  abort_if(fp == NULL)
  abort_if(!is_stbl_entry(ATable, entry) ||
	   AT_ask_idclass(entry) != opn_id)
  if (AT_ask_infix(entry) == 0)
    (void) fprintf(fp, "_%s_", AT_ident(entry));
  else
    (void) fprintf(fp, "%s", AT_ident(entry));
  (void) fprintf(fp, ":");
  sort_list= AT_ask_sargl(entry);
  if (!INTempty(sort_list))
    for (;;)
    { sort= INThead(sort_list);
      (void) fprintf(fp, " %s", AT_ident(sort));
      sort_list= INTtail(sort_list);
      if (INTempty(sort_list))
	break;
      (void) fprintf(fp, ",");
  }
  sort= AT_ask_sort(entry);
  (void) fprintf(fp, " -> %s", AT_ident(sort));
}

PRIVATE void
print_end (fp, entry)
  FILE *fp;
  int entry;
{
  abort_if(fp == NULL)
  abort_if(!is_stbl_entry(ATable, entry) ||
	   AT_ask_idclass(entry) != -spec_id)
  (void) fprintf(fp, "endspec");
}

PUBLIC void
print_spec ()
{
  FILE *fp;
  int item;
  int entry;
  int set;
  int last_set= -7007;
  int level= 0;
  void (*print)()= NULL;
  int has_line= FALSE;
  NDqueue queue;
  NDlink link;
  NDqueue done;
  char *value;

  abort_if(SpecTree == NULL ||
	   SpecDecl.all == NULL)
  abort_if(prog_flag.prt_file == NULL)
  fp= fopen(prog_flag.prt_file, "w");
  if (fp == NULL)
    fail("cannot open file \"%s\"", prog_flag.prt_file);
  for (item= 0; SpecDecl.all[item] >= 0; ++item)
  { entry= SpecDecl.all[item];
    set= AT_ask_idclass(entry);
    switch (set)
    { case spec_id:
	level= 0;
	print= print_begin;
	has_line= FALSE;
	break;
      case -spec_id:
	level= 0;
	print= print_end;
	has_line= FALSE;
	break;
      case sort_id:
	if (set != last_set)
	  (void) fprintf(fp, "sorts\n");
	level= 1;
	print= print_sort;
	has_line= TRUE;
	break;
      case opn_id:
	if (set != last_set)
	  (void) fprintf(fp, "opns\n");
	level= 1;
	print= print_opn;
	has_line= TRUE;
	break;
      default:
	abort_if(TRUE)
    }
    last_set= set;
    if (prog_flag.prt_flat)
      queue= AT_ask_insert(entry);
    else
      queue= AT_ask_accept(entry);
    link= NQfirst(queue);
    for (;;)
    { (void) fprintf(fp, "%*s", 2 * level, "");
      (*print)(fp, entry);
      if (prog_flag.prt_from)
	if (has_line)
	  (void) fprintf(fp, " (* %s(%d) *)",
			 AT_nofile(entry), AT_noline(entry));
      ++level;
      if (link != NULL)
      { done= NQcreate();
	(void) fprintf(fp, " =>");
	do
	{ (void) NQadd(done, NQdata(link));
	  (void) fprintf(fp, "\n%*s", 2 * level, "");
	  (void) fprintf(fp, "(*| %s",
			 annot_node(NQdata(link)->type)->name);
	  value= ask_antv(NQdata(link));
	  if (value != NULL)
	    (void) fprintf(fp, " %s", value);
	  (void) fprintf(fp, " |*)");
	  if (prog_flag.prt_from)
	    if (ask_grn(NQdata(link)) >= 0)
	      (void) fprintf(fp, " (* %s(%d) *)",
			     nofile(NQdata(link)), noline(NQdata(link)));
	} while ((link= NQnext(link)) != NULL &&
		 NQfind(done, NQdata(link)->type) == NULL);
	NQdestroy(done);
      }
      (void) fprintf(fp, " ;\n");
      if (link == NULL) break;
      --level;
    }
  }
}

PUBLIC void
draw_tplt ()
{
  abort_if(TpltTree == NULL)
  draw_tree(stderr, TpltTree);
}

PRIVATE int
match_begin (pattern, target)
  TNODE *pattern;
  int target;
{
  abort_if(pattern == NULL ||
	   pattern->type != tinitial_pattern)
  abort_if(!is_stbl_entry(ATable, target) ||
	   AT_ask_idclass(target) != spec_id)
  return TRUE;
}

PRIVATE int
match_sort (pattern, target)
  TNODE *pattern;
  int target;
{
  TNODE *nodep;

  abort_if(pattern == NULL ||
	   pattern->type != tsort_pattern)
  abort_if(!is_stbl_entry(ATable, target) ||
	   AT_ask_idclass(target) != sort_id)
  pattern= gt_fs(pattern);
  nodep= gt_fs(pattern);
  switch (nodep->type)
  { case tany_sort:
      return TRUE;
    case tsort_identifier:
      return ask_lexv(nodep) == AT_ask_lexv(target);
    default:
      abort_if(TRUE)
  }
  return FALSE;
}

PRIVATE int
match_opn (pattern, target)
  TNODE *pattern;
  int target;
{
  TNODE *nodep;

  abort_if(pattern == NULL ||
	   pattern->type != toperation_pattern)
  abort_if(!is_stbl_entry(ATable, target) ||
	   AT_ask_idclass(target) != opn_id)
  pattern= gt_fs(pattern);
  nodep= gt_fs(pattern);
  switch (nodep->type)
  { case tany_operation:
      break;
    case toperation_identifier:
      if (ask_lexv(nodep) != AT_ask_lexv(target) ||
	  ask_infix(nodep) != AT_ask_infix(target))
	return FALSE;
      break;
    default:
      abort_if(TRUE)
  }
  pattern= gt_rb(pattern);
  if (pattern->type == targument_descriptor)
  { nodep= gt_fs(pattern);
    switch (nodep->type)
    { case tany_argument_list:
	break;
      case targument_list:
      { INTlist arg;

	arg= AT_ask_sargl(target);
	for (nodep= gt_fs(nodep); nodep != NULL; nodep= gt_rb(nodep))
	{ if (INTempty(arg))
	    return FALSE;
	  switch (nodep->type)
	  { case tany_sort:
	      break;
	    case tsort_identifier:
	      if (ask_lexv(nodep) != AT_ask_lexv(INThead(arg)))
		return FALSE;
	      break;
	    default:
	      abort_if(TRUE)
	  }
	  arg= INTtail(arg);
	}
	if (!INTempty(arg))
	  return FALSE;
	break;
      }
      default:
	abort_if(TRUE)
    }
    pattern= gt_rb(pattern);
  }
  else if (!INTempty(AT_ask_sargl(target)))
    return FALSE;
  nodep= gt_fs(pattern);
  switch (nodep->type)
  { case tany_sort:
      break;
    case tsort_identifier:
      if (ask_lexv(nodep) != AT_ask_lexv(AT_ask_sort(target)))
	return FALSE;
      break;
    default:
      abort_if(TRUE)
  }
  return TRUE;
}

PRIVATE int
match_end (pattern, target)
  TNODE *pattern;
  int target;
{
  abort_if(pattern == NULL ||
	   pattern->type != tfinal_pattern)
  abort_if(!is_stbl_entry(ATable, target) ||
	   AT_ask_idclass(target) != -spec_id)
  return TRUE;
}

PRIVATE int rule_max= 0;
PRIVATE int rule_cnt= 0;

PUBLIC void
apply_rule (rule)
  TNODE *rule;
{
  int found= FALSE;
  TNODE *pattern;
  TNODE *nodep;
  int *decl= NULL;
  int (*match)()= NULL;
  int item;
  int entry;
  NDqueue accept;
  tANNOT *ant_ptr;
  int i;
  NDlink link;

  abort_if(rule == NULL)
  switch (rule->type)
  { case tinitial_rule:
      decl= SpecDecl.begin;
      match= match_begin;
      break;
    case tfinal_rule:
      decl= SpecDecl.end;
      match= match_end;
      break;
    case tsort_rule:
      decl= SpecDecl.sort;
      match= match_sort;
      break;
    case toperation_rule:
      decl= SpecDecl.opn;
      match= match_opn;
      break;
    default:
      abort_if(TRUE);
  }
  abort_if(decl == NULL ||
	   match == NULL)
  pattern= gt_fs(rule);
  for (item= 0; decl[item] >= 0; ++item)
  { entry= decl[item];
    if (!(*match)(pattern, entry))
      continue;
    found= TRUE;
    accept= AT_ask_accept(entry);
    for (nodep= gt_fs(gt_rb(pattern)); nodep != NULL; nodep= gt_rb(nodep))
    { ant_ptr= annot_node(nodep->type);
      abort_if(ant_ptr->node != nodep->type)
      if (prog_flag.ign_extn &&
	  ant_ptr->class == EXTERNAL)
	i= -1;
      else
	for (i= 0; i < ant_ptr->group.size; ++i)
	{ link= NQfind(accept, ant_ptr->group.item[i]->node);
	  if (link != NULL)
	  { if (ask_grn(NQdata(link)) >= 0)
	    { NQrm(link);
	      (void) NQadd(accept, nodep);
	    }
	    break;
	  }
	}
      if (i == ant_ptr->group.size)
	(void) NQadd(accept, nodep);
    }
  }
  ++rule_max;
  if (found)
    ++rule_cnt;
  else
    SEMwarn(-1, rule, "rule never matched");
}

PUBLIC int
apply_tplt ()
{
  abort_if(SpecTree == NULL ||
	   TpltTree == NULL)
  SEMclear();
  visit(TpltTree);
  abort_if(rule_cnt < 0 ||
	   rule_max < 0 ||
	   rule_cnt > rule_max)
  if (rule_cnt != rule_max)
    error("%d/%d rules applied", rule_cnt, rule_max);
  return SEMcnt();
}

PRIVATE TNODE *
move_one (type, src, dst)
  int type;
  NDqueue src;
  NDqueue dst;
{
  TNODE *result= NULL;
  NDlink link;

  abort_if(src == NULL)
  if ((link= NQfind(src, type)) != NULL)
  { result= NQdata(link);
    if (dst != NULL)
      (void) NQadd(dst, result);
    NQrm(link);
  }
  return result;
}

PRIVATE TNODE *
move_some (type, src, dst, sht)
  int type;
  NDqueue src;
  NDqueue dst;
  NDqueue sht;
{
  TNODE *result= NULL;
  NDlink link;
  char *value;
  char *tmp;

  abort_if(src == NULL ||
	   dst == NULL ||
	   sht == NULL)
  if ((link= NQfind(src, type)) != NULL)
  { result= NQdata(link);
    NQrm(link);
    value= NULL;
    while ((link= NQfind(src, type)) != NULL)
    { if (value == NULL)
      { (void) NQadd(sht, result);
	result= cp_node(result, TRUE);
	tmp= ask_antv(result);
	abort_if(tmp == NULL)
	talloc(value, strlen(tmp) + 1);
	(void) strcpy(value, tmp);
      }
      tmp= ask_antv(NQdata(link));
      abort_if(tmp == NULL)
      trealloc(value, strlen(value) + strlen(tmp) + 2);
      (void) strcat(value, "\n");
      (void) strcat(value, tmp);
      (void) NQadd(sht, NQdata(link));
      NQrm(link);
    }
    if (value != NULL)
    { del_antv(result);
      add_antv(result, value);
    }
    (void) NQadd(dst, result);
  }
  return result;
}

PRIVATE void
proc_begin (entry)
  int entry;
{
  NDqueue remain;
  NDqueue insert;
  NDqueue reject;

  remain= AT_ask_remain(entry);
  insert= AT_ask_insert(entry);
  reject= AT_ask_reject(entry);
  (void) move_some(tldc_annotation, remain, insert, reject);
  (void) move_some(tldcinit_annotation, remain, insert, reject);
}

PRIVATE void
proc_sort (entry)
  int entry;
{
  NDqueue remain;
  NDqueue insert;
  NDqueue reject;
  TNODE *ndannot;

  remain= AT_ask_remain(entry);
  insert= AT_ask_insert(entry);
  reject= AT_ask_reject(entry);
  if (move_one(tname_annotation, remain, insert) == NULL)
    (void) move_one(tlexical_annotation, remain, reject);
  if (move_one(textern_annotation, remain, insert) == NULL)
  { ndannot= move_one(tfree_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(ndannot->type)->name);
      SEMinfo("sort \"%s\" is internal, so annotation ignored",
	      AT_ident(entry));
    }
    ndannot= move_one(tnofree_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(ndannot->type)->name);
      SEMinfo("sort \"%s\" is internal, so annotation ignored",
	      AT_ident(entry));
    }
    ndannot= move_one(tequal_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(ndannot->type)->name);
      SEMinfo("sort \"%s\" is internal, so annotation ignored",
	      AT_ident(entry));
    }
    ndannot= move_one(tdraw_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(ndannot->type)->name);
      SEMinfo("sort \"%s\" is internal, so annotation ignored",
	      AT_ident(entry));
    }
    ndannot= move_one(tnodraw_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(ndannot->type)->name);
      SEMinfo("sort \"%s\" is internal, so annotation ignored",
	      AT_ident(entry));
    }
    ndannot= move_one(tparse_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(ndannot->type)->name);
      SEMinfo("sort \"%s\" is internal, so annotation ignored",
	      AT_ident(entry));
    }
    ndannot= move_one(tnoparse_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(ndannot->type)->name);
      SEMinfo("sort \"%s\" is internal, so annotation ignored",
	      AT_ident(entry));
    }
  }
  else
  { if (move_one(tfree_annotation, remain, insert) == NULL)
      if (move_one(tnofree_annotation, remain, reject) == NULL)
      { SEMwarn(entry, (TNODE *) NULL, "missing \"%s\" annotation",
		annot_node(tfree_annotation)->name);
	SEMinfo("sort \"%s\" is external, so it should have that one",
		AT_ident(entry));
      }
    if (move_one(tequal_annotation, remain, insert) == NULL)
    { SEMmiss(entry, (TNODE *) NULL, "missing \"%s\" annotation",
	      annot_node(tequal_annotation)->name);
      SEMinfo("sort \"%s\" is external, so it must have that one",
	      AT_ident(entry));
    }
    if (move_one(tdraw_annotation, remain, insert) == NULL)
    { if (move_one(tnodraw_annotation, remain, reject) == NULL)
      { SEMwarn(entry, (TNODE *) NULL, "missing \"%s\" annotation",
		annot_node(tdraw_annotation)->name);
	SEMinfo("sort \"%s\" is external, so it should have that one",
		AT_ident(entry));
      }
      ndannot= move_one(tparse_annotation, remain, reject);
      if (ndannot == NULL)
      { if (move_one(tnoparse_annotation, remain, reject) == NULL)
	{ SEMwarn(entry, (TNODE *) NULL, "missing \"%s\" annotation",
		  annot_node(tparse_annotation)->name);
	  SEMinfo("sort \"%s\" is external, so it should have that one",
		  AT_ident(entry));
	}
      }
      else
      { SEMmiss(entry, ndannot, "unexpected \"%s\" annotation",
		annot_node(tparse_annotation)->name);
	SEMinfo("sort \"%s\" has not a \"%s\" annotation, so this one ignored",
		AT_ident(entry), annot_node(tdraw_annotation)->name);
      }
    }
    else if (move_one(tparse_annotation, remain, insert) == NULL)
      if (move_one(tnoparse_annotation, remain, reject) == NULL)
      { SEMwarn(entry, (TNODE *) NULL, "missing \"%s\" annotation",
		annot_node(tparse_annotation)->name);
	SEMinfo("sort \"%s\" is external, so it should have that one",
		AT_ident(entry));
      }
  }
}

PRIVATE int
islexical (name)
  char *name;
{
  char *p;

  abort_if(name == NULL)
  p= name;
  if (!isascii(*p))
    return FALSE;
  if (!isalpha(*p))
    return FALSE;
  while (*++p != '\0')
  { if (!isascii(*p))
      return FALSE;
    if (!isalnum(*p) &&
	(*p != '_' ||
	 *(p + 1) == '_' ||
	 *(p + 1) == '\0'))
      return FALSE;
  }
  return TRUE;
}

PRIVATE void
proc_opn (entry)
  int entry;
{
  NDqueue remain;
  NDqueue insert;
  NDqueue reject;
  TNODE *ndannot;
  TNODE *ndprefix;
  TNODE *ndname;
  char *prefix= NULL;
  char *name= NULL;

  remain= AT_ask_remain(entry);
  insert= AT_ask_insert(entry);
  reject= AT_ask_reject(entry);
  ndprefix= move_one(tusing_annotation, remain, reject);
  if (ndprefix == NULL)
  { ndprefix= move_one(tusingsort_annotation, remain, reject);
    if (ndprefix == NULL)
      ;
    else
      prefix= AT_ident(AT_ask_sort(entry));
  }
  else
  { prefix= ask_antv(ndprefix);
    abort_if(prefix == NULL)
  }
  if (prefix == NULL)
    ndname= move_one(tname_annotation, remain, insert);
  else
    ndname= move_one(tname_annotation, remain, reject);
  if (ndname == NULL)
  { ndname= move_one(tlexical_annotation, remain, reject);
    if (ndname == NULL)
    { ndname= move_one(tlexicalifpossible_annotation, remain, reject);
      if (ndname == NULL)
	ndname= move_one(tinternal_annotation, remain, reject);
      else
      { name= AT_ident(entry);
	if (!islexical(name))
	  name= NULL;
      }
    }
    else
      name= AT_ident(entry);
  }
  else
  { name= ask_antv(ndname);
    abort_if(name == NULL)
  }
  if (prefix != NULL && name != NULL)
  { char *tmp;

    talloc(tmp, strlen(prefix) + strlen(name) + 2);
    (void) sprintf(tmp, "%s_%s", prefix, name);
    name= tmp;
  }
  if (name != NULL &&
      (prefix != NULL || ndname->type != tname_annotation))
  { ndannot= new_node(tname_annotation);
    copyattrs(ndannot, ndname);
    del_antv(ndannot);
    add_antv(ndannot, name);
    (void) NQadd(insert, ndannot);
  }
  if (move_one(textern_annotation, remain, insert) == NULL)
  { ndannot= move_one(tcall_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(tcall_annotation)->name);
      SEMinfo("opn. \"%s\" is internal, so annotation ignored",
	      AT_ident(entry));
    }
    ndannot= move_one(tpartial_annotation, remain, (NDqueue) NULL);
    if (ndannot != NULL)
    { int errcnt;
      unsigned arg, max_arg;
      char *p, *q;

      errcnt= SEMcnt();
      max_arg= INTlength(AT_ask_sargl(entry));
      p= ask_antv(ndannot);
      abort_if(p == NULL)
      for (; (p= strchr(p, '$')) != NULL; p= q)
      { q= ++p;
	if (*q == '$')
	{ ++q;
	  continue;
	}
	for (; *q != '\0'; ++q)
	  if (isascii(*q) && isdigit(*q))
	    continue;
	  else
	    break;
	if (p != q &&
	    *p != '0' &&
	    (arg= atoi(p)) >= 1 &&
	    arg <= max_arg)
	  continue;
	SEMmiss(entry, ndannot, "error in \"%s\" annotation",
		annot_node(tpartial_annotation)->name);
	if (p == q)
	  SEMinfo("opn. \"%s\", missing argument number",
		  AT_ident(entry));
	else
	  SEMinfo("opn. \"%s\", wrong argument number",
		  AT_ident(entry));
      }
      if (errcnt == SEMcnt())
	(void) NQadd(insert, ndannot);
      else
	(void) NQadd(reject, ndannot);
    }
    if (ATfind(stbl_ptr(ATable), AT_ask_sort(entry), c_extern) == NULL)
    { if (move_one(tnonconstructor_annotation, remain, insert) == NULL)
	(void) move_one(tconstructor_annotation, remain, reject);
    }
    else
      if (move_one(tnonconstructor_annotation, remain, insert) == NULL)
      { ndannot= move_one(tconstructor_annotation, remain, reject);
	if (ndannot == NULL)
	  SEMmiss(entry, (TNODE *) NULL, "missing \"%s\" annotation",
		  annot_node(tnonconstructor_annotation)->name);
	else
	  SEMmiss(entry, ndannot, "unexpected \"%s\" annotation",
		  annot_node(tconstructor_annotation)->name);
	SEMinfo("opn. \"%s\" is of an external sort, so it must be a non-constructor",
		AT_ident(entry));
      }
  }
  else
  { ndannot= move_one(tcall_annotation, remain, (NDqueue) NULL);
    if (ndannot == NULL)
    { if (name == NULL)
      { if (ndname == NULL)
	  SEMmiss(entry, (TNODE *) NULL, "missing \"%s\" annotation",
		  annot_node(tname_annotation)->name);
	else if (ndname->type == tlexicalifpossible_annotation)
	  SEMmiss(entry, ndname, "failed \"%s\" annotation",
		  annot_node(tlexicalifpossible_annotation)->name);
	else if (ndname->type == tinternal_annotation)
	  SEMmiss(entry, ndname, "unexpected \"%s\" annotation",
		  annot_node(tinternal_annotation)->name);
	else
	  abort_if(TRUE)
	SEMinfo("opn. \"%s\" is external, so it needs external name",
		AT_ident(entry));
      }
    }
    else
    { int errcnt;
      unsigned arg, max_arg;
      char *p, *q;

      errcnt= SEMcnt();
      max_arg= INTlength(AT_ask_sargl(entry));
      p= ask_antv(ndannot);
      abort_if(p == NULL)
      for (; (p= strchr(p, '$')) != NULL; p= q)
      { q= ++p;
	if (*q == '$')
	{ ++q;
	  continue;
	}
	for (; *q != '\0'; ++q)
	  if (isascii(*q) && isdigit(*q))
	    continue;
	  else
	    break;
	if (p != q &&
	    *p != '0' &&
	    (arg= atoi(p)) >= 1 &&
	    arg <= max_arg)
	  continue;
	SEMmiss(entry, ndannot, "error in \"%s\" annotation",
		annot_node(tcall_annotation)->name);
	if (p == q)
	  SEMinfo("opn. \"%s\", missing argument number",
		  AT_ident(entry));
	else
	  SEMinfo("opn. \"%s\", wrong argument number",
		  AT_ident(entry));
      }
      if (errcnt == SEMcnt())
	(void) NQadd(insert, ndannot);
      else
	(void) NQadd(reject, ndannot);
    }
    ndannot= move_one(tpartial_annotation, remain, reject);
    if (ndannot != NULL)
    { SEMwarn(entry, ndannot, "unexpected \"%s\" annotation",
	      annot_node(tpartial_annotation)->name);
      SEMinfo("opn. \"%s\" is external, so annotation ignored",
	      AT_ident(entry));
    }
    if (ATfind(stbl_ptr(ATable), AT_ask_sort(entry), c_extern) == NULL)
    { if (move_one(tnonconstructor_annotation, remain, insert) == NULL)
      { ndannot= move_one(tconstructor_annotation, remain, reject);
	if (ndannot == NULL)
	  SEMmiss(entry, (TNODE *) NULL, "missing \"%s\" annotation",
		  annot_node(tnonconstructor_annotation)->name);
	else
	  SEMmiss(entry, ndannot, "unexpected \"%s\" annotation",
		  annot_node(tconstructor_annotation)->name);
	SEMinfo("opn. \"%s\" is of an internal sort, so it must be a non-constructor",
		AT_ident(entry));
      }
    }
    else
      if (move_one(tnonconstructor_annotation, remain, reject) == NULL)
	(void) move_one(tconstructor_annotation, remain, reject);
  }
}

PRIVATE void
proc_end (entry)
  int entry;
{
  NDqueue remain;
  NDqueue insert;
  NDqueue reject;

  remain= AT_ask_remain(entry);
  insert= AT_ask_insert(entry);
  reject= AT_ask_reject(entry);
  (void) move_some(tldc_annotation, remain, insert, reject);
}

PUBLIC int
proc_spec ()
{
  struct
  { int *decl;
    void (*proc)();
  } order[9], *p;
  int item;
  int entry;
  NDqueue insert;
  NDlink link;
  int sort;
  IT *opns;

  abort_if(SpecTree == NULL)
  p= order, p->decl= SpecDecl.begin, p->proc= proc_begin;
  ++p,      p->decl= SpecDecl.sort,  p->proc= proc_sort;
  ++p,      p->decl= SpecDecl.opn,   p->proc= proc_opn;
  ++p,      p->decl= SpecDecl.end,   p->proc= proc_end;
  ++p,      p->decl= NULL,           p->proc= NULL;
  SEMclear();
  for (p= order; p->decl != NULL; ++p)
  { for (item= 0; p->decl[item] >= 0; ++item)
    { entry= p->decl[item];
      AT_add_remain(entry, NQdup(AT_ask_accept(entry)));
      (*p->proc)(entry);
      abort_if(NQfirst(AT_ask_remain(entry)) != NULL)
      insert= AT_ask_insert(entry);
      if (NQfirst(insert) != NULL)
      { int type;
	char *value;
	int *line;
	IT *type_tbl= NULL;
	IT *line_tbl= NULL;

	link= NQfirst(insert);
	do
	{ type= annot_node(NQdata(link)->type)->attr;
	  value= ask_antv(NQdata(link));
	  ATset(stbl_ptr(ATable), entry, type,
		(CLR_TYPE) ALIN(void, value));
	  if (ask_grn(NQdata(link)) < 0)
	    continue;
	  if (type_tbl == NULL)
	  { type_tbl= ITcreate(10, 5, 0);
	    line_tbl= ITcreate(20, 10, 0);
	  };
	  line= ask_line(NQdata(link));
	  abort_if(line == NULL)
	  (void) ITadd(type, type_tbl);
	  (void) ITadd(line[0], line_tbl);
	  (void) ITadd(line[1], line_tbl);
	} while ((link= NQnext(link)) != NULL);
	if (type_tbl != NULL)
	{ AT_add_Gannot(entry, type_tbl);
	  AT_add_Gline(entry, line_tbl);
	}
      }
    }
  }
  for (item= 0; SpecDecl.sort[item] >= 0; ++item)
  { sort= SpecDecl.sort[item];
    opns= AT_ask_opns(sort);
    abort_if(opns == NULL)
    if (opns->size == 0)
      continue;
    if (ATfind(stbl_ptr(ATable), sort, c_extern) == NULL)
    { int i;

      for (i= 0; i < opns->size; ++i)
	if (ATfind(stbl_ptr(ATable), opns->data[i], c_nonconstructor) == NULL)
	  break;
      if (i == opns->size)
      { SEMmiss(sort, (TNODE *) NULL, "sort without constructors");
	SEMinfo("sort \"%s\" is internal, so it needs one at least",
		AT_ident(sort));
      }
    }
    else
    { int i;

      for (i= 0; i < opns->size; ++i)
	if (ATfind(stbl_ptr(ATable), opns->data[i], c_extern) != NULL)
	  break;
      if (i == opns->size)
      { SEMmiss(sort, (TNODE *) NULL, "sort without external operations");
	SEMinfo("sort \"%s\" is external, so it needs one at least",
		AT_ident(sort));
      }
    }
  }
  return SEMcnt();
}

PUBLIC void
save_spec ()
{
  abort_if(SpecTree == NULL)
  save_tree(stdout, SpecTree);
}
