view tests/agcl/oldagsrc/pgg24-3.syn @ 15:f5acaf0c8a29

Don't cast through "volatile int". Causes a gcc warning nowadays. XXX: should put something else back here to frighten the optimizer
author David A. Holland
date Tue, 31 May 2022 01:00:55 -0400
parents 13d2b8934445
children
line wrap: on
line source

{/*
   AnaGram Syntax Analyzer.
   Copyright (c) Jerome T. Holland, 1989, 1990, 1991, 1992
   All Rights Reserved.
*/
  #include HEADERS
  #include STDLIB
  #include STDIO
  #include STRING
  #include DATA
  #include TREES
  #include STK
  #include CTYPE
	#include ASSERT
	#include SETJMP
  #include PGG
  #include MYALLOC
}

[
  auto resynch
  context type = cint
  default reductions
 ~declare pcb
  diagnose errors
//  far tables
//	enum constant name = "pgg_%_token"
    lines and columns
    error frame
  line numbers
// ~allow macros
  nest comments
  parser stack size = 50
  pointer input
//  rule coverage
 ~test range
  token names
  parser name = pgg
  test file mask = "*.syn"

  distinguish keywords {'.'}
//  coverage file name = "e:\\agc\\pgg24.nrc"
  near functions
]

any digit      = digit + hex letter
anything       = ~eof
backslash      = '\\'
blank char     = ' ' + tab
c literal elem = ~(single quote + double quote + eol chars + backslash + eof)
digit          = '0-9'
double quote   = '"'
eof            = 0 + 26
eol chars      = carriage return + newline
hex letter     = 'a-f' + 'A-F'
letter         = 'a-z' + 'A-Z' + '_'
newline        = '\n'
nonoctal digit = any digit - octal digit
octal digit    = '0-7'
carriage return= '\r'
simple c char  = ~('{' + '}' + single quote + double quote + eof)
simple string char = ~eof - (any digit + double quote + backslash + eol chars)
single quote   = '\''
tab            = '\t'
vertical space = '\f' + '\v'

/*
alternator       //[~diagnostic]
 -> "/...", blank?...
*/

arrow
 -> "->", blank?...

/*
colon
 -> ':', space?
*/

comma
 -> ',', space?

ellipsis
 -> "...", blank?...

equals
 -> '=', space?            =n_statements++;

bang
 -> '!', space?            =n_statements++;

left brace
 -> '{', space?

left bracket
 -> '[', space?

left parenthesis
 -> '(', space?

minus
 -> '-', space?

plus
 -> '+', space?

right bracket
 -> ']', blank?...

right brace
 -> '}', blank?...

right parenthesis
 -> ')', blank?...

right quote
 -> single quote, blank?...
/*
star
 -> '*', blank?...

ampersand
 -> '&', blank?...
*/

tilde
 -> '~', space?

vertical bar
 -> '|', space?


(void) syntax definition $
 -> blank?..., end of line?, [complete statement..., statement?], eof

(void) complete statement
 -> production:t, end of line      =production(t);
 -> simple statement, end of line  =n_statements++;

(void) statement
 -> production:t                   =production(t);
 -> simple statement               =n_statements++;

(int) production
 -> left hand side:type                                   =iws(),type;
 -> left hand side, right hand side
 -> production:type, end of line, right hand side  =concat_list(),type;
 -> production, end of line, additional rule spec...

(void) right hand side
 -> arrow, rule specs

(void) simple statement
 -> definition
 -> embedded c
 -> configuration section

(int) left hand side
 -> token name list                       =n_statements++, 0;
 -> type definition:d, token name list    =n_statements++, head_list_3(d);

(void) token name list            //left hand side of productions
 -> token name:x                          =sws(head_list_2(x));
 -> token name list, comma, token name:x  =aws(head_list_2(x));

(int) token name
 -> name                                  =0;
 -> name, '$', blank?...                  =1;

(int) type definition
 -> left parenthesis, data type, ')', space?    =ids(cast_dict),fis();

(void) proper vp rule specs
 -> vp rule spec:n                              =sws(n);
 -> proper vp rule specs, additional vp rule spec

(void) additional vp rule spec
 -> vertical bar, vp rule spec:n                =aws(n);

(void) vp rule specs
 -> reduction procedure:pn                     =sws((iws(),vp_form3(pn)));
 -> vp rule specs, additional vp rule spec

(void) vp rules
 -> vp rule specs | proper vp rule specs

(int) vp rule spec
 -> grammar rule, reduction procedure:s        =vp_form3(s);

(void) rule specs
 -> reduction procedure:n                      =sws(form_spec_2(form1(),n));
 -> rule spec:n                           =sws(n);
 -> rule specs, additional rule spec

(void) additional rule spec
 -> vertical bar, rule spec:n             =aws(n);

(int) rule spec
 -> grammar rule, reduction procedure:s        =form_spec_2(form2(),s);

(void) grammar rule
 -> rule element:e, parameter name:p      =iws(),pf2x(e,p);
 -> grammar rule, comma,
    rule element:e, parameter name:p      =pf2x(e,p);

(int) reduction procedure
 ->                                       =0;
 -> equals, embedded c                    =proc_spec_4(0);
 -> equals, c expression, ';', blank?...  =proc_spec_4(1);

(void) data type
 -> type name
 -> type name, template field
 -> type name, template field?, abstract declarator  =concat_string();

(void) type name
 -> name
 -> "::", !sss("::");, blank?..., name      =concat_string();
 -> type name, "::", !ass("::");, blank?..., name      =concat_string();

(void) abstract declarator
 -> indirect data type
 -> direct abstract declarator
 -> indirect data type, direct abstract declarator  =concat_string();

(void) template field
// -> {'<', blank?... = acs('<');}, data type, '>', blank?... =acs('>'), concat_string();
 -> template field head, data type, '>', blank?... =acs('>'), concat_string();

template field head
 -> '<', blank?...    = acs('<');
 -> template field head, data type, ',', blank?... =acs(','), concat_string();



(void) direct abstract declarator
 -> {left parenthesis =scs('(');}, abstract declarator,
     right parenthesis =concat_string(), acs(')');

(void) star
 -> '*', blank?...                           =sss(" *");

(void) pointer
 -> star
 -> star, name                               =concat_string();

(void) indirect data type
 -> pointer
 -> indirect data type, pointer              =concat_string();

(void) name string
 -> letter:c  =scs(c);
 -> name string, letter + digit :c           =acs(c);
 -> name string, blank..., letter + digit :c =acs(' '), acs(c);

(void) enum fix
 -> "enum", blank..., letter + digit : c      =sss("enum "), acs(c);
 -> enum fix, letter + digit:c                =acs(c);
 -> enum fix, blank..., letter + digit:c      =acs(' '), acs(c);

(void) name
 -> name string, blank?...

(void) blank
 -> blank char
 -> c comment

(void) space
 -> blank...
 -> blank..., continuation
 -> continuation

(void) continuation
 -> comment, next line
 -> next line

(void) next line
 -> carriage return?, newline
 -> carriage return?, newline, blank...

(void) white
 -> blank
 -> carriage return?, newline
 -> comment, carriage return?, newline

(void) end of line
 -> comment, carriage return?, newline
 -> carriage return?, newline
 -> end of line, white
 -> end of line, vertical space //form feed

(void) comment
 -> "//", ~eol chars & ~eof?...

(int) character
 -> signed number
 -> '^', 33..126:x, blank?...               =x & 0x1f;
 -> single quote, char const:c, right quote =(character_seen=1),c;

(int) signed number
 -> sign:s, simple number:n, blank?...      =s*n;

(int) sign
 -> plus?                                   =1;
 -> minus                                   =-1;

(int) simple number
 -> decimal number
 -> '0', octal number:n                     =n;
 -> {"0x" | "0X"}, hex number:n             =n;

(int) decimal number
 -> '1-9':d                        =d - '0';
 -> decimal number:n, '0-9':d      =10*n + d - '0';

(int) octal number
 ->                                =0;
 -> octal number:n, '0-7':d        =8*n + d - '0';

(int) hex number
 -> hex digit:d                    =d;
 -> hex number:n, hex digit:d      =16*n + d;

(int) hex digit
 -> '0-9':d                        =d-'0';
 -> 'a-f' + 'A-F':d                =(d&7)+9;

(int) rule element
 -> token
 -> mid rule action:p              =vp_8a(p);

(int) token
 -> union:n                        =form_element_1(n);
 -> virtual production

(node) union
 -> intersection
 -> union:u, plus, intersection:i            =make_or_node(u,i);
 -> union:u, minus, intersection:i           =make_minus_node(u,i);

(node) intersection
 -> negation
 -> intersection:i, '&', space?, negation:n  =make_and_node(i,n);

(node) negation
 -> simple set
 -> tilde, negation:n                        =make_tilde_node(n);

(int) char const
 -> anything -(single quote + backslash + eol chars):c =
     case_sensitive ? (c) : toupper(c);
 -> escape sequence
 -> octal escape
 -> three octal
 -> hex escape

(node) simple set
 -> character range                =ss3();
 -> character:n                    =ss1(n); //=ss4(n);
 -> name                           =ss2();
 -> left parenthesis, union:x,
    right parenthesis              =x;

(void) character range
 -> single quote, char const:l, '-', char const:r, right quote  =
    (character_seen=1),range(l,r);
 -> character:l, "..", space?, character:r        =range(l,r);

(void) definition
 -> name, equals, union:n              =definition_1(n);
 -> name, equals, virtual production:p =definition_2(p);
 -> name, equals, mid rule action:p    =definition_2(vp_8a(p));

(void) enum definition
 -> name                             =definition_3(enum_base++);
 -> name, equals, character:n        =definition_3(enum_base = n), enum_base++;

(void) enum statement
 -> "enum", space, left brace, enum definition
 -> enum statement, comma, enum definition

(void) keyword string
 -> keyword string head, string, double quote, blank?...

(void) string
 -> string A | string B | string C

(void) keyword string head
 -> double quote =ics();

(int) string char
 -> simple string char
 -> escape sequence
 -> three octal:n =null_warning(n);

(int) escape sequence
 -> "\\a"               ='\a';
 -> "\\b"               ='\b';
 -> "\\f"               ='\f';
 -> "\\n"               ='\n';
 -> "\\r"               ='\r';
 -> "\\t"               ='\t';
 -> "\\v"               ='\v';
 -> "\\\\"              ='\\';
 -> "\\?"               = '\?';
 -> "\\'"               ='\'';
 -> "\\\""              ='"';

{
  int null_warning(int n) {
		extern void warning_here(const char *);
    if (n == 0) warning_here("Null character in keyword string");
    return n;
  }
}

(int) one octal
 -> backslash, '0-7':n                      =n&7;

(int) two octal
 -> one octal:n, '0-7':d                    =n*8 + (d&7);

(int) three octal
 -> two octal:n, '0-7':d                    =n*8 + (d&7);

(int) octal escape
 -> one octal | two octal

(int) hex escape
 -> "\\x", hex number:x                     =x;

(void) string A
 -> string char:c               =acs(c);
 -> any digit:c                 =acs(c);
 -> string, string char:c       =acs(c);
 -> string A, any digit:c       =acs(c);
 -> string B, nonoctal digit:c  =acs(c);

(void) string B
 -> octal escape:c             =acs(null_warning(c));
 -> string, octal escape:c     =acs(null_warning(c));

(void) string C
 -> hex escape:c               =acs(null_warning(c));
 -> string, hex escape:c       =acs(null_warning(c));

(int) parameter name
 ->                            =0;
 -> ':', space?, c name        =ids(cvar_dict),fis();

(void) simple name
 -> letter:c                      =scs(c);
 -> simple name, letter + digit:c =acs(c);

(void) c name
 -> simple name, blank?...

(void) configuration section
// -> '[', blank?..., [global parameter | end of line]/..., right bracket
 -> '[', configuration parameters, right bracket

(void) configuration parameters
 -> blank?..., end of line?, [configuration parameter list, end of line?]

(void) configuration parameter list
 -> configuration parameter
 -> configuration parameter list, end of line, configuration parameter


(void) configuration parameter
 -> name                             =gp4(1);
 -> tilde, name                      =gp4(0);
 -> name, equals, data type          =gp2();
 -> name, equals, keyword string     =gp3();
 -> enum fix, blank?..., equals, keyword string =gp3();
 -> name, equals, signed number:n    =gp5(n);
 -> attribute statement

(void) attribute statement
 -> "left", token list               =set_prec(1,0);
 -> "right", token list              =set_prec(0,1);
 -> "nonassoc", token list           =set_prec(0,0);
 -> "sticky", token list             =set_sticky();
 -> "subgrammar", token list         =set_subgrammar();
 -> "hidden", token list                         =set_hidden();
 -> new reserve statement, list end              =new_reserve();
 -> enum statement, list end
 -> "disregard", blank..., token:t               =disregard(t);
 -> "lexeme", token list                         =set_lexeme();

list end
 -> [comma | continuation], right brace

(void) new reserve statement
 -> "distinguish", blank..., "keywords", blank..., left brace,
      union:n                              =init_reserve(identify_node(n));
 -> new reserve statement, comma, union:n  =aws(identify_node(n));

(void) token list
 -> blank..., left brace, tokens, list end

(void) tokens
 -> token:t                             =sws(t);
 -> tokens, comma, token:t              =aws(t);

(int) virtual production
 -> keyword string                                        =vp_s();
 -> keyword string, '?', blank?...                        =vp_5(vp_s());
 -> left brace, vp rules, right brace                     =vp_1();
 -> left brace, vp rules, "}...", blank?...               =vp_2();
 -> left bracket, proper vp rule specs, right bracket     =vp_3();
 -> left bracket, proper vp rule specs, "]...", blank?... =vp_4();
 -> union:n, '?', blank?...                          =vp_5(form_element_1(n));
 -> union:n, "?...", blank?...                       =vp_6(form_element_1(n));
 -> union:n, ellipsis                                =vp_7(form_element_1(n));
 -> left brace, proper vp rule specs, "}/...", blank?...   =vp_9();
 -> left bracket, proper vp rule specs, "]/...", blank?... =vp_10();

(int) mid rule action
 -> bang, embedded c                    =mid_line(proc_spec_4(0));
 -> bang, c expression, ';', blank?...  =mid_line(proc_spec_4(1));

(void) embedded c
 -> embedded c head, c code, right brace

(void) embedded c head
 -> '{', [carriage return?, newline]...           =copyon();

(void) c code
 ->                                      =copyoff();
 -> c code first, c text                 =copyoff();

(void) c code first
 -> simple c char - eol chars
 -> c comment
 -> comment, carriage return?, newline
 -> c character constant, single quote
 -> c string constant, double quote

(void) c text
 ->
 -> c text, c char

(void) c char             //c char represents the content of embedded c
 -> simple c char
 -> '{', c text, '}'
 -> c comment
 -> comment, carriage return?, newline
 -> c character constant, single quote
 -> c string constant, double quote

(void) c expression head
 -> =copyon();

(void) c expression
 -> c expression head, c chars                     =copyoff();

(void) c chars
 -> c expression char
 -> c chars, c expression char
 -> c chars, blank

(void) c expression char //c char represents the content of embedded C
 -> simple c char - ';' - eol chars - blank char
 -> "\\\n"
 -> c character constant, single quote
 -> c string constant, double quote

(void) c comment
 -> c comment head, "*/"

(void) c comment head
 -> "/*"
 -> c comment head, ~eof

(void) c comment, c comment head
 -> c comment head, c comment =
    {if (nest_comments) PCB.reduction_token = pgg_c_comment_head_token;}

(void) c string constant
 -> double quote, [c literal elem | single quote | backslash, anything]...

(void) c character constant
 -> single quote, [c literal elem | double quote | backslash, anything]...

[
  hidden {
    arrow, comma, ellipsis, equals, left brace,
    left bracket, left parenthesis, minus, plus, right bracket,
    list end,
    right brace, right parenthesis, right quote, star, tilde,
    vertical bar, simple statement, token name,
    rule spec, pointer, indirect data type, name string,
    blank, space, next line, white, end of line, sign, simple number,
    simple set, one octal, two octal, three octal,
    string A, string B, string C,
    simple name, c text, c char, c chars, c expression char,
    c expression head,
    c comment head,
    c code, c name,
    bang,
    complete statement,
    rule specs, vp rule specs, additional rule spec,
    data type, template field, abstract declarator,
    direct abstract declarator, pointer,
    name string, proper vp rule specs, additional vp rule spec,
    new reserve statement, anything, union, intersection, negation
  }
]

{
pgg_pcb_type pgcb;
#define PCB pgcb

#define PARSE_STACK_OVERFLOW parse_stack_overflow()
#define SYNTAX_ERROR log_syntax_error()
#define GET_CONTEXT CONTEXT.y = PCB.line, CONTEXT.x = PCB.column;

#define REDUCTION_TOKEN_ERROR reduction_token_error()

int save_case_sensitive;

void reduction_token_error(void) {
	assert(0);
}

extern jmp_buf error_continuation;
extern char longjmp_msg[];

void parse_stack_overflow(void) {
  sprintf(longjmp_msg, "Excessive recursion");
  longjmp(error_continuation,1);
}

extern string_dict   *cast_dict;
extern int            character_seen;
extern int            enum_base;
extern unsigned char *input_base;
extern int            nest_comments;
extern int            precedence_level;
extern int            syntax_error_flag;
extern int            case_sensitive;
extern int            n_statements;

       void log_error_location(int,int);
       void log_error_here(void);
       void log_error(void);

       node make_or_node(node,node);
       node make_and_node(node,node);
       node make_minus_node(node,node);
       node make_tilde_node(node);
       node ss1(int);
       node ss2(void);
       node ss3(void);

       void acs(int);
       void aws(int);
       void atkn(int);
       int  copyoff(void);
       int  copyon(void);
       int  definition_1(node);
       int  definition_2(int);
       int  definition_3(int);
       int  form_element_1(node);
       int  form_spec_2(int, int);
       int  form1(void);
       int  form2(void);
       int  gp2(void);
       int  gp3(void);
       void gp4(int);
       int  gp5(int);
       int  head_list_1(int);
       int  head_list_2(int);
static int head_list_3(int);
       void ics(void);
       int  identify_node(node);
       void init_reserve(int);
       void iws(void);
       int  mid_line(int);
       int  new_cast_spec_1(void);
       int  new_cast_spec_2(void);
       void new_reserve(void);
       int  null_warning(int);
/*       void pf2(int, int, int); */
       void pf2x(int, int);
       int  pr3(int);
       int  pr4(int);
       int  proc_spec_4(int);
       int  proc_spec_5(void);
       void production(int);
       int  range(int, int);
       void scs(int);
static void set_prec(int,int);
/*
       void suppress(void);
       void suppress_all(void);
       void suppress_except(void);
       void suppress_initial(void);
*/
       void sws(int);
       void tp4(int);
       int vp_form3(int);
       int vp_s(void);
       int vp_1(void);
       int vp_2(void);
       int vp_3(void);
       int vp_4(void);
       int vp_5(int);
       int vp_6(int);
       int vp_7(int);
       int vp_8(int);
       int vp_8a(int);
       int vp_9(void);
       int vp_10(void);

/*
static int reserve(int pt) {
  int key = map_token_number[vp_s()].key;
  map_key_word[key].reserve = pt;
  return pt;
}
*/

/*
static void anomalous(void) {
  map_token_number[vp_s()].anomalous = 1;
}
*/

int *disregard_list = NULL;
int n_disregard_list = 0;

void disregard(int tn) {
  iws();
  if (n_disregard_list) {
    int *p = disregard_list;
    while (n_disregard_list--) aws(*p++);
    free(disregard_list);
  }
  xws(tn);
  disregard_list = build_list();
  n_disregard_list = fis();
}

extern tsd *syntax_errors;

static void log_syntax_error(void) {
  int eline = PCB.line, ecol = PCB.column;
  int flag = PCB.error_frame_token == pgg_c_comment_token ||
             PCB.error_frame_token == pgg_embedded_c_token;

  reset_stk();
  if (flag && PCB.token_number == pgg_eof_token) {
    eline = ERROR_CONTEXT.y;
    ecol = ERROR_CONTEXT.x;
  }
  log_error_location(ecol,eline);
  asprintf("%s in %s",
    PCB.error_message,pgg_token_names[PCB.error_frame_token]);
  log_error();
  syntax_error_flag++;
	if (syntax_errors->nt < 50) return;
	sss("Too many syntax errors, parse aborted");
	log_error();
	PCB.exit_flag = AG_SYNTAX_ERROR_CODE;
}

static int head_list_3(int type)   {
  int i, n = tis();
  for (i = 0; i < n; i ++) {
    int tn = list_base[i];
    token_number_map *tp = &map_token_number[tn];
    int ptt = tp->value_type;
    if (ptt && ptt != type) {
      log_error_here();
      asprintf("Type Redefinition of T%03d: ", tn);
        atkn(tn);
      log_error();
    }
    tp->value_type = type;
    if (ptt == 0 && tp->rp_arg && type == void_token_type)  {
      log_error_here();
      asprintf("Void token, %s, used as parameter",
          dict_str(tkn_dict,tp->token_name));
      log_error();
    }
  }
  return type;
}

static void set_prec(int left, int right){
  int n = tis();
  precedence_level++;
  while (n--) {
    int k = list_base[n];
    token_number_map *tp = &map_token_number[k];
    tp->left_associative = left;
    tp->right_associative = right;
    tp->precedence_level = precedence_level;
  }
  rws();
}

static void set_sticky(void){
  int n = tis();
  while (n--) {
    int k = list_base[n];
    token_number_map *tp = &map_token_number[k];
    tp->sticky = 1;
  }
  rws();
}

static void set_subgrammar(void){
  int n = tis();
  while (n--) {
    int k = list_base[n];
    token_number_map *tp = &map_token_number[k];
    tp->subgrammar = 1;
  }
  rws();
}

void set_hidden(void) {
  int *lb = list_base;
  int n = tis();
  while (n--) map_token_number[*lb++].fine_structure = 1;
  rws();
}

void set_lexeme(void) {
  int n = tis();
  while (n--) {
    token_number_map *tp = &map_token_number[list_base[n]];
/*    tp->lexeme = tp->subgrammar = 1; */
    tp->lexeme = 1;
  }
  rws();
}

void parse(void) {
  pgcb.pointer = input_base;
  pgg();
}
}