[nest comments]
{
/*
   AnaGram Syntax Analyzer. Copyright (c) Jerome T. Holland, 1989, 1990.
   All Rights Reserved.
*/
  #define PARSE_PROC_DECLARATION parse()
  #define STACK_DEPTH 100
  #define NEXT_TOKEN next_token_11()
/*  #define GET_TOKEN next_token_11() */
  #define GET_TOKEN tkn = tv = (unsigned char) *input_pointer;
  #define ADVANCE_POINTER input_pointer++
  #define TOKEN tkn
  #define TOKEN_VALUE tv
  #define PARSE_STACK_OVERFLOW\
  {fprintf(stderr,"parse stack overflow\n");myabort();}
/*  #define ERROR {syntax_error(); /* return 0; */} */
  #define ERROR {if (TOKEN == eof_tkn) return 0;}
  #define DIAGNOSE diagnose_syntax_error
  #define LINE lines
  #define COLUMN col
  #define TRACK_COLUMN
  #define TRACK_LINE
  #define STACK_COLUMN
  #define STACK_LINE
  #define POINTER input_pointer
  #define BACKTRACK
  #define RESYNCH_EOF eof_tkn
  #define RESYNCH
}

{
  #include "assert.h"
  #include <stdio.h>
  #include <dos.h>
  #include <string.h>
  #include "data.h"
  #include "arrays.h"
  #include "trees.h"
  #include "myalloc.h"
  #include "stk.h"
  #include "pgg18.h"

  typedef enum {PGG18_TOKENS} pgg18_tkns;

  extern unsigned char tkn;
  extern long tv;

  extern string_dict *tkn_dict;
  extern string_dict *param_dict;
  extern string_dict *cast_dict;
  extern tsd *form_table;
  extern tsd *dummy_token_table;
  extern tsd *reducing_proc_table;
  extern tsd *form_length_table;
  extern tsd *bnf_table;
  extern tsd *primary_token_table;
  extern tsd *cast_table;                       /* index of cast list */
  extern tsd *cast_list;                        /* lists cast id's */

  extern tsd *form_base;
  extern tsd *form_item;
  extern tsd *form_length;

  extern FILE *list;
  extern char *input_pointer;
  extern char *input_base;
  extern char *string_base;

extern int partition_required;

node val(int);
char *build_string();
int *build_list();
extern int syntax_error_flag;

}

character set = 0.255\
blank = ' ',
comma = ',' !
digit = '0-9'@
newline = 012 #
carriage return# = 015
letter = 'a-z'  'A-Z' + '_'
letter = 'a-z' + 'A-Z + '_'
letter = 'a+z' + 'A-Z + '_'
tilde = '~"
semicolon = ";'
star = '*'   bar = '|'
colon = ':'
lparen = '('
rparen = ')'
lbrace = '{'
right brace = '}'
squote = '''
dquote = '"'
backslash = '\'
slash = '/'
dollar = '$'
dot = '.'
lbrack = '['
rbrack = ']'
tab = 9
minus = '-'
ampersand = '&'
plus = '+'

eof = 0 + 26 +

anything = ~eof

simple c char = ~(star + '{' + '}' + squote + dquote + slash + eof

c literal elem = ~(squote + dquote + backslash + eof)

c char                          //c char represents the content of embedded c
 -> simple c char
 -> slash, ~star & ~eof
 -> star, ~slash & ~eof
 -> c comment
 -> '{', c text, '}'
 -> c literal char, squote
 -> c literal string, dquote

head list names                           //left hand side of productions
 -> name, grammar flag                           = head_list_1(int);
 -> head list names, comma, space, name, grammar flag  = head_list_2(int);

*head list
 -> head list names
 -> head list names, '[', simple space, token parameters, ']', blanks


token parameters,
 -> token parameter, [comma, simple space, token parameter]...

token parameter
 -> name                            =gp1;
 -> name, '=', simple space, name   =gp2;
 -> tilde, simple space, name       =gp1;
 -> name, '=', simple space, tilde, simple space, name   =gp2;
 -> name, '=', simple space, string =gp3;
 -> name, '=', simple space, number =gp1;

grammar flag     $$
 ->                             = flag1;
 -> dollar, blanks              = flag2;


name
 -> {letter = scs(char);},
    [(letter + digit) = acs(char); | mid line white = atbc;...

blanks -> | blanks, mid line white

mid line white
 -> blank
 -> tab
 -> c comment

space -> | space, white

simple space
 -> blanks, comment, blanks]

white
 -> mid line white
 -> comment

end of line
 -> comment, space

comment -> [';'  [~carriage return & ~newline &~eof]...],
  carriage return?, newline
/*
comment -> carriage return?, newline

continuation -> | end of line
*/

continuation = [comment, mid line white?..]
   
decimal number
 -> '1-9'                       = number_1(int);
 -> decimal number, '0-9'      = number_2(int,int);

octal number
 -> '0'                         = number_1(int);
 -> octal number, '0-'        =number_3(int,int);

hex number
 -> '0', 'x' + 'X'          = number_1(int);
 -> hex number, '0-9'      =number_4(int,int);
 -> hex number, 'A-F'      =number_5(int,int);
 -> hex number, 'a-f'      =number_6(int,int);

number
 -> decimal number
 -> octal number
 -> hex number

range
 -> squote, anything, minus, anything, squote = range(unsigned, unsigned);
 -> squote, anything, dot, anything, squote   = range;
 -> number, blanks, dot, simple space, number        = range;

simple set
 -> range, blanks                       = node ss3;
 -> squote, anything, squote, blanks   = node ss1(unsigned);
 -> number, blanks                     = node ss1(unsigned);
 -> name                                = node ss2;
 -> '(', simple space, union, continuation, ')', blanks = long pass(long);

negation
 -> simple set
 -> tilde, simple space, negation    node make_tilde_node(node)

form element
 -> union      =form_element_1(node);
 -> virtual production


vp form element
 -> name                        =form_element_2//;
// -> '(', simple space, union, continuation, ')',blanks  =form_element_1(node);


intersection
 -> negation
 -> intersection, ampersand, simple space, negation  = node make_and_node(node,node);

union
 -> intersection
 -> union, plus, simple space, intersection     = node make_or_node(node,node);
 -> union, minus, simple space, intersection    = node make_minus_node(node,node);

complete definition
  -> definition, end of line

definition 
 -> name, '=', simple space, union =definition_1(node) ;
 -> name, '=', simple space, virtual production =definition_2(int) ;

parameter flag
 ->                                    = flag1;
 -> star, simple space                        = flag2;

string
 -> {dquote = ics;}, [~dquote & ~eof = acs]..., dquote, blanks

form body
 -> parameter flag, form element, parameter name      = fb1(int, int, int);
 -> form body, comma, simple space, parameter flag,
    form element, parameter name =fb2(int,int,int);

parameter name
 ->                    = pn1;
 -> '\', simple space, c name = pn2;
{
fb1(int flag, int element, int name) {
  pf1(flag, element,name);

}

fb2(int flag, int element, int name) {
  pf2(flag, element,name);
}
pn1()   {return 0;}
pn2() {ids(cvar_dict); return fis();}

}

parametrized form
 -> proper form, '[', simple space, form parameters, ']', blanks

parametrized vp form
 -> proper vp form, '[', simple space, form parameters, ']', blanks

form parameters
 -> form parameter, [comma, simple space, form parameter]...

form parameter
 -> name                            =gp1;
 -> tilde, simple space, name       =gp1;
 -> name, '=', simple space, tilde, simple space, name   =gp2;
 -> name, '=', simple space, name   =gp2;
 -> name, '=', simple space, string =gp3;
 -> name, '=', simple space, number =gp1;

form
 ->               =form1;
 -> form body     =form2;

null form -> =form1;

proper form
 -> form body     =form2;

vp form
 ->               =iws;
 -> form body

proper vp form
 -> form body


proper vp form spec
 -> proper vp form                             =form_spec_4;
 -> proper vp form, '=', simple space, proc spec   =form_spec_3(int);
 -> parametrized vp form =form_spec_4;
 -> parametrized vp form,
     ':', simple space, proc spec   =form_spec_3(int);

mid line action
 -> '!', simple space, proc spec           =mid_line(int);

form spec
/*
 -> form
*/
 -> null form
 -> proper form
 -> null form, ':', simple space, proc spec   =form_spec_2(int,int);
 -> proper form, ':', simple space, proc spec   =form_spec_2(int,int);
 -> parametrized form
 -> parametrized form, 
    ':, simple space, proc spec   =form_spec_2(int,int);

proper form spec 
 -> proper form 
 -> proper form, ':', simple space, proc spec  =form_spec_2(int,int);
 -> parametrized form
 -> parametrized form, 
    :', simple space, proc spec   =form_spec_2(int,int);

proc spec
  -> proc name
  -> proc name, '(', simple space, ')', blanks
  -> proc name, '(', simple space, casts, ')', blanks  = proc_spec_3(int);

  -> proc name, '(', simple space, casts, ')', blanks, embedded c
  -> proc cast, embedded c   =proc_spec_4(int);

proc cast
 ->                                            =pc_1;
 -> '(, simple space, cast, ')', simple space = pc_2;

{
pc_1() {return 0;}
pc_2() { ids(cast_dict); return fis();}
}

/***/
/*
cast
 -> simple name
 -> simple name, mid line white...
 -> simple name, star                        =new_cast_1;
 -> simple name, mid line white..., star     =new_cast_1;
 -> simple name, mid line white..., cast     =new_cast_2;
 -> simple name, mid line white..., star, cast =new_cast_3;
 -> simple name, star, cast                    =new_cast_3;

real space
 -> comment, simple space
 -> mid line white...

cast
 -> simple name
 -> simple name, real space
 -> simple name, star                        =new_cast_1;
 -> simple name, real space, star     =new_cast_1;
 -> simple name, real space, cast     =new_cast_2;
 -> simple name, real space, star, cast =new_cast_3;
 -> simple name, star, cast                    =new_cast_3;
{
new_cast_1() {
  ass(" *");
}
new_cast_2()   {
  its(' ',0);
  concat_string();
}
new_cast_3()   {
  its('*',0);
  new_cast_2();
}
}

proc name
 -> partial proc name   = new_proc_name_4(int);

partial proc name
 -> simple name                            =new_proc_name_1;
 -> simple name, mid line white...         =new_proc_name_1;
 -> simple name, mid line white..., partial proc name = new_proc_name_2(int);
 -> simple name, mid line white..., star, mid line white...,
    partial proc name = new_proc_name_3(int);
 -> simple name, star, mid line white..., partial proc name = new_proc_name_3;
{
new_proc_name_4(int name) {
  ids(cast_dict);
  check_size(map_proc_name, name, 3*name/2);
  map_proc_name[name].cast = fis();
  return name;
}

new_proc_name_1()   {
  int name;

  ids(proc_dict);
  name = fis();
  ics();
  return name;
}
new_proc_name_2(int name)   {
  its(' ',0);
  concat_string();
  return name;
}
new_proc_name_3(int name) {
  its('*',0);
  return new_proc_name_2(name);
}
}

casts
 -> cast                       = new_cast_spec_1;
 -> casts, comma, simple space, cast  = new_cast_spec_2;

{
new_cast_spec_1() {
  ids(cast_dict);
  sws(fis());
}
new_cast_spec_2() {
  ids(cast_dict);
  aws(fis());
}

}

/*****/


/*
proc name
 -> proc cast, c name    :proc_name_1
 -> c name               :proc_name_2
*/
simple name
 -> letter                     =scs(char);
 -> simple name, letter        =acs(char);
 -> simple name, digit         =acs(char);

c name
 -> simple name
 -> c name, blank
/*
star cast
 -> c name, star       =cast_1;
 -> star cast, blank
 -> star cast, star    = cast_2;

cast
 -> c name
 -> star cast

proc cast
 -> c name, blank
 -> star cast

cast spec
 -> cast                    =cast_spec_1;
 -> proc cast, c name       =cast_spec_2;

casts
 -> *cast spec                                       =sws(int);
 -> casts, comma, simple space, *cast spec                  =aws(int);
*/

form specs
 -> form spec                                       =sws(int);
 -> form specs, bar, simple space, proper form spec        =aws(int);

proper form specs
 -> proper form spec                                       =sws(int);
 -> proper form specs, bar, simple space, proper form spec        =aws(int);

vp form specs
 -> proper vp form spec                                  =sws;
 -> vp form specs, bar, simple space, proper vp form spec       =aws;

statement
 -> complete production                  =production(int);
 -> complete definition
 -> complete embedded c
 -> complete precedence grammar
 -> complete global parameter declaration

unterminated statement
 ->
 -> production       =production(int);
 -> definition
 -> embedded c
 -> precedence grammar
 -> global parameter declaration

complete precedence grammar
 -> precedence grammar, end of line

complete global parameter declaration
 -> global parameter declaration, end of line

global parameter declaration
 -> '[', simple space, global parameters, ']', blanks

global parameters
 -> global parameter, [comma, simple space, global parameter]...

global parameter
 -> name                            =gp1;
 -> tilde, simple space, name       =gp1;
 -> name, '=', simple space, tilde, simple space, name   =gp2;
 -> name, '=', simple space, name   =gp2;
 -> name, '=', simple space, string =gp3;
 -> name, '=', simple space, number =gp1;

{
gp1() { ids(param_dict); return fis();}
gp2() { ids(param_dict);fis(); ids(param_dict); fis();}
gp3() { rcs(); ids(param_dict); fis();}
}


precedence grammar
 -> pr_header, end of line?, 
    '{', levels, end of line?, '}' = build_pr_grmr;

pr_header
 -> "%pg", simple space, name, "->", simple space, name =init_prec_grmr;

{
int pr_gram;
int pr_gram_base;
int pr_gram_levels;

typedef enum {la_op, ra_op, pr_op, su_op} op_type;

init_prec_grmr() {
  token_name();
  pr_gram_base = fis();
  token_name();
  pr_gram = fis();
  pr_gram_levels = 0;
}

build_pr_grmr() {
  int *tn, t, i;

  tn = allocate(pr_gram_levels + 1, int);
  t = ntkns + 1;
  ntkns += pr_gram_levels - 1;
  check_size(map_token_number, ntkns, ntkns);
  tn[0] = pr_gram_base;
  tn[pr_gram_levels] = pr_gram;
  map_token_number[pr_gram].non_terminal_flag = 1;
  for (i = 1; i < pr_gram_levels; i++,t++ ) {
    map_token_number[t].non_terminal_flag = 1;
    tn[i] = t;
  }
  while (pr_gram_levels) {
    switch (fis()) {
    case la_op:
      la_op_forms(tn[pr_gram_levels], tn[pr_gram_levels-1]);
      break;
    case ra_op:
      ra_op_forms(tn[pr_gram_levels], tn[pr_gram_levels-1]);
      break;
    case pr_op:
      pr_op_forms(tn[pr_gram_levels], tn[pr_gram_levels-1]);
      break;
    case su_op:
      su_op_forms(tn[pr_gram_levels], tn[pr_gram_levels-1]); 
      break;
    }
    pr_gram_levels--;
  }
}
} 
/*
parameter names
 -> simple name                  =pl1
 -> parameter names, mid line white..., comma, simple space, simple name   =pl2
 -> parameter names, comma, simple space, simple name   =pl2
*/
parameter name list
 ->               =pl4     ;
 -> '\', simple space, parameter names, mid line white..., continuation =pl3;
 -> '\', simple space, parameter names, comment, 
    mid line white?..., continuation =pl3;

single parameter
 ->                                             =pl6;
 -> '\', simple space, simple name, mid line white..., continuation  =pl5;
 -> '\', simple space, simple name, comment, 
    mid line white?..., continuation  =pl5;

parameter names
 -> simple name, mid line white..., comma, simple space, simple name
 -> simple name, comma, simple space, simple name

{
pl1() {ids(cvar_dict); sws(fis());} 
pl2() {ids(cvar_dict); aws(fis());}
pl3() {
  int right;

  ids(cvar_dict); 
  right = fis();
  ids(cvar_dict);
  sis(right);
}
pl4() {sis(0); sis(0);}
pl5() {ids(cvar_dict);}
pl6() {sis(0);}
}
levels
 -> end of line?, level
 -> levels, end of line, level

level
 -> "%bl", simple space, parameter name list, operators  =pg_level_la
 -> "%br", simple space, parameter name list, operators =pg_level_ra;
 -> "%up", simple space, single parameter, operators            =pg_level_pr;
 -> "%us", simple space, single parameter, operators            =pg_level_su

operators
 -> form element  =    la_op_1(int);
 -> form element, '=',
    simple space, proc spec  =la_op_2(int, int);
 -> operators, comma, simple space, form element  =la_op_3(int);
 -> operators, comma, simple space, form element,
    '=', simple space, proc spec  =la_op_4(int, int);
{
pg_level_la() {
  sis(la_op);
  pr_gram_levels++;
}
pg_level_ra() {
  sis(ra_op);
  pr_gram_levels++;
}
pg_level_pr() {
  sis(pr_op);
  pr_gram_levels++;
}
pg_level_su() {
  sis(su_op);
  pr_gram_levels++;
}
la_op_1(int tn) {
  sws(tn); aws(0);
}

la_op_2(int tn,int pn) {
  sws(tn); aws(pn);
}

la_op_3(int tn) {
  aws(tn); aws(0);
}

la_op_4(int tn,int pn) {
  aws(tn); aws(pn);
}

pr_op_forms(int hltn, int lltn) {
  int name;
  token_number_map tm;
  int op, *op_list, i, k, pn,fn;
  int pf;
  int arg;

  op_list = build_list();
  k = fis();
  arg = fis();
  pf1(0,lltn,0);
  fn = form2();
  form_spec_2(fn,0);
  at(bnf_table,hltn,fn);
  map_form_number[fn].prim_tkn = hltn;
  for (i = 0; i< k;) {
    op = op_list[i++];
    pn = op_list[i++];
    pf = (pn && map_proc_name[pn].n_params);
    pf1(0,op,0);
    pf2(pf,hltn,arg);
    fn = form2();
    form_spec_2(fn,pn);
    at(bnf_table,hltn,fn);
    map_form_number[fn].prim_tkn = hltn;
  }
  free(op_list);
}

ra_op_forms(int hltn, int lltn) {
  int name;
  token_number_map tm;
  int op, *op_list, i, k, pn,fn;
  int pf;
  int right, left;

  op_list = build_list();
  k = fis();
  right = fis();
  left = fis();
  pf1(0,lltn,0);
  fn = form2();
  form_spec_2(fn,0);
  at(bnf_table,hltn,fn);
  map_form_number[fn].prim_tkn = hltn;
  for (i = 0; i< k;) {
    op = op_list[i++];
    pn = op_list[i++];
    pf = (pn && map_proc_name[pn].n_params);
    pf1(pf,lltn,left);
    pf2(0,op,0);
    pf2(pf,hltn,right);
    fn = form2();
    form_spec_2(fn,pn);
    at(bnf_table,hltn,fn);
    map_form_number[fn].prim_tkn = hltn;
  }
  free(op_list);
}

su_op_forms(int hltn, int lltn) {
  int name;
  token_number_map tm;
  int op, *op_list, i, k, pn,fn;
  int pf;
  int arg;

  op_list = build_list();
  k = fis();
  arg = fis();
  pf1(0,lltn,0);
  fn = form2();
  form_spec_2(fn,0);
  at(bnf_table,hltn,fn);
  map_form_number[fn].prim_tkn = hltn;
  for (i = 0; i< k;) {
    op = op_list[i++];
    pn = op_list[i++];
    pf = (pn && map_proc_name[pn].n_params);
    pf1(pf,hltn,arg);
    pf2(0,op,0);
    fn = form2();
    form_spec_2(fn,pn);
    at(bnf_table,hltn,fn);
    map_form_number[fn].prim_tkn = hltn;
  }
  free(op_list);
}

la_op_forms(int hltn, int lltn) {
  int name;
  token_number_map tm;
  int op, *op_list, i, k, pn,fn;
  int pf;
  int left,right,type;

  op_list = build_list();
  k = fis();
  right = fis();
  left = fis();
  pf1(0,lltn,0);
  fn = form2();
  form_spec_2(fn,0);
  at(bnf_table,hltn,fn);
  map_form_number[fn].prim_tkn = hltn;
  type = map_token_number[lltn].cast;
  if (type == 0) type = default_token_type;
  for (i = 0; i< k;) {
    op = op_list[i++];
    pn = op_list[i++];
    pf = (pn && map_proc_name[pn].n_params);
    pf1(pf,hltn,left);
    pf2(0,op,0);
    pf2(pf,lltn,right);
    fn = form2();
    form_spec_2(fn,pn);
    if (pn && map_proc_name[pn].auto_proc) finish_proc_def(pn,fn,type);
    at(bnf_table,hltn,fn);
    map_form_number[fn].prim_tkn = hltn;
  }
  free(op_list);
}
}

statement list
 -> space
 -> statement list, statement

file $
 -> statement list, unterminated statement, eof


complete production
 -> production, end of line

production
 -> head list                           =pr1();
 -> head list, "->", blanks, form specs     =pr2;
 -> type definition, head list        =pr3(int);
 -> type definition, head list, "->", blanks, form specs
 -> complete production, "->", blanks, form specs        =pr4(int);

type definition
 -> '(', simple space, cast, ')', simple space             =typedef2;
{
typedef2() {ids(cast_dict); return fis();}
pr1() {iws(); return default_token_type;}
pr2() { return default_token_type;}
pr3(int type) {
  iws();
  return type;
}
pr4(int type) { concat_list(); return type;}

}

virtual production
 -> string      =vp_s;
 -> '{', simple space, vp form specs, '}', blanks         =vp_1;
 -> '{', simple space, vp form specs, '}', "...", blanks  =vp_2;
 -> '[', simple space, vp form specs, ']', blanks         =vp_3;
 -> '[', simple space, vp form specs, ']', "...", blanks  =vp_4;
 -> vp form element, '?', blanks                        =vp_5(int);
 -> vp form element, '?', "...", blanks                 =vp_6(int);
 -> vp form element, "...", blanks                      =vp_7(int);
 -> mid line action                                     =vp_8(int);

complete embedded c
 -> embedded c, end of line
/*
 -> '{', c code, '}', blanks, end of line
*/

embedded c
/* -> '{', c code */
 -> '{', c code, '}', blanks

c code -> c text          = copyoff;

c text
 ->                       = copyon;
 -> c text, c char

{
c comment text
 -> 
 -> c comment text, ~star & ~slash & ~eof
 -> c comment text, slash, ~star & ~eof
 -> c comment text, star, ~slash & ~eof
 -> c comment text, c comment

c comment
 -> slash, star, c comment text, star, slash

c comment 
 -> c comment body, slash

c comment body
 -> c comment text, star
 -> c comment body, star

c comment text
 -> slash, star
 -> c comment text, ~star & ~slash & ~eof 
 -> c comment text, slash, ~star & ~eof 
 -> c comment body, ~star & ~slash & ~eof

c comment text, c comment
 -> c comment text, c comment


c literal string
 -> dquote
 -> c literal string, c literal elem
 -> c literal string, squote
 -> c literal string, backslash, anything

c literal char
 -> squote
 -> c literal char, c literal elem
 -> c literal char, dquote
 -> c literal char, backslash, anything