source: translator/Parser/cfa.y @ 51b7345

ADTaaron-thesisarm-ehast-experimentalcleanup-dtorsctordeferred_resndemanglerenumforall-pointer-decaygc_noraiijacob/cs343-translationjenkins-sandboxmemorynew-astnew-ast-unique-exprnew-envno_listpersistent-indexerpthread-emulationqualifiedEnumresolv-newstringwith_gc
Last change on this file since 51b7345 was 51b7345, checked in by Peter A. Buhr <pabuhr@…>, 9 years ago

initial commit

  • Property mode set to 100644
File size: 99.6 KB
Line 
1/*                               -*- Mode: C -*-
2 *
3 * CForall Grammar Version 1.0, Copyright (C) Peter A. Buhr 2001 -- Permission is granted to copy this
4 *      grammar and to use it within software systems.  THIS GRAMMAR IS PROVIDED "AS IS" AND WITHOUT
5 *      ANY EXPRESS OR IMPLIED WARRANTIES.
6 *
7 * cfa.y --
8 *
9 * Author           : Peter A. Buhr
10 * Created On       : Sat Sep  1 20:22:55 2001
11 * Last Modified By : Peter A. Buhr
12 * Last Modified On : Mon Nov  3 11:21:43 2003
13 * Update Count     : 856
14 */
15
16/* This grammar is based on the ANSI99 C grammar, specifically parts of EXPRESSION and STATEMENTS, and on the
17   C grammar by James A. Roskind, specifically parts of DECLARATIONS and EXTERNAL DEFINITIONS.  While parts
18   have been copied, important changes have been made in all sections; these changes are sufficient to
19   constitute a new grammar.  In particular, this grammar attempts to be more syntactically precise, i.e., it
20   parses less incorrect language syntax that must be subsequently rejected by semantic checks.  Nevertheless,
21   there are still several semantic checks required and many are noted in the grammar. Finally, the grammar
22   is extended with GCC and CFA language extensions. */
23
24/* Acknowledgments to Richard Bilson, Glen Ditchfield, and Rodolfo Gabriel Esteves who all helped when I got
25   stuck with the grammar. */
26
27/* The root language for this grammar is ANSI99 C. All of ANSI99 is parsed, except for:
28
29   1. designation with '=' (use ':' instead)
30
31   Most of the syntactic extensions from ANSI90 to ANSI99 C are marked with the comment "ANSI99". This grammar
32   also has two levels of extensions. The first extensions cover most of the GCC C extensions, except for:
33
34   1. nested functions
35   2. generalized lvalues
36   3. designation with and without '=' (use ':' instead)
37   4. attributes not allowed in parenthesis of declarator
38
39   All of the syntactic extensions for GCC C are marked with the comment "GCC". The second extensions are for
40   Cforall (CFA), which fixes several of C's outstanding problems and extends C with many modern language
41   concepts. All of the syntactic extensions for CFA C are marked with the comment "CFA". As noted above,
42   there is one unreconcileable parsing problem between ANSI99 and CFA with respect to designators; this is
43   discussed in detail before the "designation" grammar rule. */
44
45%{
46#define YYDEBUG_LEXER_TEXT (yylval)                     /* lexer loads this up each time */
47#define YYDEBUG 1                                       /* get the pretty debugging code to compile*/
48
49#undef __GNUC_MINOR__
50
51#include <cstdio>
52#include <stack>
53#include "TypedefTable.h"
54#include "lex.h"
55#include "ParseNode.h"
56#include "LinkageSpec.h"
57
58DeclarationNode *theTree = 0;                           /* the resulting parse tree */
59LinkageSpec::Type linkage = LinkageSpec::Cforall;
60std::stack< LinkageSpec::Type > linkageStack;
61TypedefTable typedefTable;
62%}
63
64/************************* TERMINAL TOKENS ********************************/
65
66/* keywords */
67%token TYPEDEF
68%token AUTO EXTERN REGISTER STATIC
69%token INLINE                                           /* ANSI99 */
70%token FORTRAN                                          /* ANSI99, extension ISO/IEC 9899:1999 Section J.5.9(1) */
71%token CONST VOLATILE
72%token RESTRICT                                         /* ANSI99 */
73%token FORALL LVALUE                                    /* CFA */
74%token VOID CHAR SHORT INT LONG FLOAT DOUBLE SIGNED UNSIGNED
75%token BOOL COMPLEX IMAGINARY                           /* ANSI99 */
76%token TYPEOF LABEL                                     /* GCC */
77%token ENUM STRUCT UNION
78%token TYPE FTYPE DTYPE CONTEXT                         /* CFA */
79%token SIZEOF
80%token ALIGNOF ATTRIBUTE EXTENSION                      /* GCC */
81%token IF ELSE SWITCH CASE DEFAULT DO WHILE FOR BREAK CONTINUE GOTO RETURN
82%token CHOOSE FALLTHRU TRY CATCH FINALLY THROW          /* CFA */
83%token ASM                                              /* ANSI99, extension ISO/IEC 9899:1999 Section J.5.10(1) */
84
85/* names and constants: lexer differentiates between identifier and typedef names */
86%token<tok> IDENTIFIER          TYPEDEFname             TYPEGENname
87%token<tok> ATTR_IDENTIFIER     ATTR_TYPEDEFname        ATTR_TYPEGENname
88%token<tok> INTEGERconstant     FLOATINGconstant        CHARACTERconstant       STRINGliteral
89%token<tok> ZERO                ONE                     /* CFA */
90
91/* multi-character operators */
92%token ARROW                    /* ->                           */
93%token ICR DECR                 /* ++   --                      */
94%token LS RS                    /* <<   >>                      */
95%token LE GE EQ NE              /* <=   >=      ==      !=      */
96%token ANDAND OROR              /* &&   ||                      */
97%token ELLIPSIS                 /* ...                          */
98
99%token MULTassign       DIVassign       MODassign       /* *=   /=      %=      */
100%token PLUSassign       MINUSassign                     /* +=   -=              */
101%token LSassign         RSassign                        /* <<=  >>=             */
102%token ANDassign        ERassign        ORassign        /* &=   ^=      |=      */
103
104/* Types declaration */
105%union
106{
107  Token tok;
108  ParseNode *pn;
109  ExpressionNode *en;
110  DeclarationNode *decl;
111  DeclarationNode::TyCon aggKey;
112  DeclarationNode::TypeClass tclass;
113  StatementNode *sn;
114  ConstantNode *constant;
115  InitializerNode *in;
116}
117
118%type<tok> zero_one  identifier  no_attr_identifier  no_01_identifier
119%type<tok> identifier_or_typedef_name  no_attr_identifier_or_typedef_name  no_01_identifier_or_typedef_name
120%type<constant> string_literal_list
121
122/* expressions */
123%type<constant> constant
124%type<en> tuple                         tuple_expression_list
125%type<en> unary_operator                assignment_operator
126%type<en> primary_expression            postfix_expression              unary_expression
127%type<en> cast_expression               multiplicative_expression       additive_expression     shift_expression
128%type<en> relational_expression         equality_expression             AND_expression          exclusive_OR_expression
129%type<en> inclusive_OR_expression       logical_AND_expression          logical_OR_expression   conditional_expression
130%type<en> constant_expression           assignment_expression           assignment_expression_opt
131%type<en> comma_expression              comma_expression_opt
132%type<en> argument_expression_list      argument_expression             for_control_expression  assignment_opt
133%type<en> subrange
134
135/* statements */
136%type<sn> labeled_statement     compound_statement      expression_statement    selection_statement
137%type<sn> iteration_statement   jump_statement          exception_statement     asm_statement
138%type<sn> fall_through_opt      fall_through
139%type<sn> statement             statement_list
140%type<sn> block_item_list       block_item
141%type<sn> case_clause
142%type<en> case_value            case_value_list
143%type<sn> case_label            case_label_list
144%type<sn> switch_clause_list_opt switch_clause_list     choose_clause_list_opt  choose_clause_list
145%type<pn> handler_list          handler_clause          finally_clause
146
147/* declarations */
148%type<decl> abstract_array abstract_declarator abstract_function abstract_parameter_array
149%type<decl> abstract_parameter_declaration abstract_parameter_declarator abstract_parameter_function
150%type<decl> abstract_parameter_ptr abstract_ptr
151
152%type<aggKey> aggregate_key
153%type<decl>  aggregate_name
154
155%type<decl> array_dimension array_parameter_1st_dimension array_parameter_dimension multi_array_dimension
156
157%type<decl> assertion assertion_list_opt
158
159%type<en>   bit_subrange_size_opt bit_subrange_size
160
161%type<decl> basic_declaration_specifier basic_type_name basic_type_specifier direct_type_name indirect_type_name
162
163%type<decl> context_declaration context_declaration_list context_declaring_list context_specifier
164
165%type<decl> declaration declaration_list declaration_list_opt declaration_qualifier_list
166%type<decl> declaration_specifier declarator declaring_list
167
168%type<decl> elaborated_type_name
169
170%type<decl> enumerator_list enum_name
171%type<en> enumerator_value_opt
172
173%type<decl> exception_declaration external_definition external_definition_list external_definition_list_opt
174
175%type<decl> field_declaration field_declaration_list field_declarator field_declaring_list
176%type<en> field field_list
177
178%type<decl> function_array function_declarator function_definition function_no_ptr function_ptr
179
180%type<decl> identifier_parameter_array identifier_parameter_declarator identifier_parameter_function
181%type<decl> identifier_parameter_ptr identifier_list
182
183%type<decl> new_abstract_array new_abstract_declarator_no_tuple new_abstract_declarator_tuple
184%type<decl> new_abstract_function new_abstract_parameter_declaration new_abstract_parameter_list
185%type<decl> new_abstract_ptr new_abstract_tuple
186
187%type<decl> new_array_parameter_1st_dimension
188
189%type<decl> new_context_declaring_list new_declaration new_field_declaring_list
190%type<decl> new_function_declaration new_function_return new_function_specifier
191
192%type<decl> new_identifier_parameter_array new_identifier_parameter_declarator_no_tuple
193%type<decl> new_identifier_parameter_declarator_tuple new_identifier_parameter_ptr
194
195%type<decl> new_parameter_declaration new_parameter_list new_parameter_type_list new_parameter_type_list_opt
196
197%type<decl> new_typedef_declaration new_variable_declaration new_variable_specifier
198
199%type<decl> old_declaration old_declaration_list old_declaration_list_opt old_function_array
200%type<decl> old_function_declarator old_function_no_ptr old_function_ptr
201
202%type<decl> parameter_declaration parameter_list parameter_type_list
203%type<decl> parameter_type_list_opt
204
205%type<decl> paren_identifier paren_typedef
206
207%type<decl> storage_class storage_class_name storage_class_list
208
209%type<decl> sue_declaration_specifier sue_type_specifier
210
211%type<tclass> type_class
212%type<decl> type_declarator type_declarator_name type_declaring_list
213
214%type<decl> typedef typedef_array typedef_declaration typedef_declaration_specifier typedef_expression
215%type<decl> typedef_function typedef_parameter_array typedef_parameter_function typedef_parameter_ptr
216%type<decl> typedef_parameter_redeclarator typedef_ptr typedef_redeclarator typedef_type_specifier
217%type<decl> typegen_declaration_specifier typegen_type_specifier
218
219%type<decl> type_name type_name_no_function
220%type<decl> type_parameter type_parameter_list
221
222%type<en> type_name_list
223
224%type<decl> type_qualifier type_qualifier_name type_qualifier_list type_qualifier_list_opt type_specifier
225
226%type<decl> variable_abstract_array variable_abstract_declarator variable_abstract_function
227%type<decl> variable_abstract_ptr variable_array variable_declarator variable_function variable_ptr
228
229/* initializers */
230%type<in>  initializer initializer_list initializer_opt
231
232/* designators */
233%type<en>  designator designator_list designation
234
235
236/* Handle single shift/reduce conflict for dangling else by shifting the ELSE token. For example, this string
237   is ambiguous:
238   .---------.                  matches IF '(' comma_expression ')' statement
239   if ( C ) S1 else S2
240   `-----------------'  matches IF '(' comma_expression ')' statement ELSE statement */
241
242%nonassoc THEN  /* rule precedence for IF '(' comma_expression ')' statement */
243%nonassoc ELSE  /* token precedence for start of else clause in IF statement */
244
245%start translation_unit                                 /* parse-tree root */
246
247%%
248/************************* Namespace Management ********************************/
249
250/* The grammar in the ANSI C standard is not strictly context-free, since it relies upon the distinct terminal
251   symbols "identifier" and "TYPEDEFname" that are lexically identical.  While it is possible to write a
252   purely context-free grammar, such a grammar would obscure the relationship between syntactic and semantic
253   constructs.  Hence, this grammar uses the ANSI style.
254
255   Cforall compounds this problem by introducing type names local to the scope of a declaration (for instance,
256   those introduced through "forall" qualifiers), and by introducing "type generators" -- parametrized types.
257   This latter type name creates a third class of identifiers that must be distinguished by the scanner.
258
259   Since the scanner cannot distinguish among the different classes of identifiers without some context
260   information, it accesses a data structure (the TypedefTable) to allow classification of an identifier that
261   it has just read.  Semantic actions during the parser update this data structure when the class of
262   identifiers change.
263
264   Because the Cforall language is block-scoped, there is the possibility that an identifier can change its
265   class in a local scope; it must revert to its original class at the end of the block.  Since type names can
266   be local to a particular declaration, each declaration is itself a scope.  This requires distinguishing
267   between type names that are local to the current declaration scope and those that persist past the end of
268   the declaration (i.e., names defined in "typedef" or "type" declarations).
269
270   The non-terminals "push" and "pop" derive the empty string; their only use is to denote the opening and
271   closing of scopes.  Every push must have a matching pop, although it is regrettable the matching pairs do
272   not always occur within the same rule.  These non-terminals may appear in more contexts than strictly
273   necessary from a semantic point of view.  Unfortunately, these extra rules are necessary to prevent parsing
274   conflicts -- the parser may not have enough context and look-ahead information to decide whether a new
275   scope is necessary, so the effect of these extra rules is to open a new scope unconditionally.  As the
276   grammar evolves, it may be neccesary to add or move around "push" and "pop" nonterminals to resolve
277   conflicts of this sort.  */
278
279push:
280                {
281                    typedefTable.enterScope();
282                }
283        ;
284
285pop:
286                {
287                    typedefTable.leaveScope();
288                }
289        ;
290
291/************************* CONSTANTS ********************************/
292
293constant:
294                /* ENUMERATIONconstant is not included here; it is treated as a variable with type
295                   "enumeration constant". */
296        INTEGERconstant         { $$ = new ConstantNode(ConstantNode::Integer,   $1); }
297        | FLOATINGconstant      { $$ = new ConstantNode(ConstantNode::Float,     $1); }
298        | CHARACTERconstant     { $$ = new ConstantNode(ConstantNode::Character, $1); }
299        ;
300
301identifier:
302        IDENTIFIER
303        | ATTR_IDENTIFIER                               /* CFA */
304        | zero_one                                      /* CFA */
305        ;
306
307no_01_identifier:
308        IDENTIFIER
309        | ATTR_IDENTIFIER                               /* CFA */
310        ;
311
312no_attr_identifier:
313        IDENTIFIER
314        ;
315
316zero_one:                                               /* CFA */
317        ZERO
318        | ONE
319        ;
320
321string_literal_list:                                    /* juxtaposed strings are concatenated */
322        STRINGliteral                           { $$ = new ConstantNode(ConstantNode::String, $1); }
323        | string_literal_list STRINGliteral     { $$ = $1->append( $2 ); }
324        ;
325
326/************************* EXPRESSIONS ********************************/
327
328primary_expression:
329        IDENTIFIER                                      /* typedef name cannot be used as a variable name */
330                { $$ = new VarRefNode($1); }
331        | zero_one
332                { $$ = new VarRefNode($1); }
333        | constant
334                { $$ = $1; }
335        | string_literal_list
336                { $$ = $1; }
337        | '(' comma_expression ')'
338                { $$ = $2; }
339        | '(' compound_statement ')'                    /* GCC, lambda expression */
340                { $$ = new ValofExprNode($2); }
341        ;
342
343postfix_expression:
344        primary_expression
345        | postfix_expression '[' push assignment_expression pop ']'
346                 /* CFA, comma_expression disallowed in the context because it results in a commom user error:
347                    subscripting a matrix with x[i,j] instead of x[i][j]. While this change is not backwards
348                    compatible, there seems to be little advantage to this feature and many disadvantages. It
349                    is possible to write x[(i,j)] in CFA, which is equivalent to the old x[i,j]. */
350                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Index), $1, $4); }
351        | postfix_expression '(' argument_expression_list ')'
352                { $$ = new CompositeExprNode($1, $3); }
353        | postfix_expression '.' no_attr_identifier
354                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::FieldSel), $1,
355                                             new VarRefNode($3)); }
356        | postfix_expression '.' '[' push field_list pop ']' /* CFA, tuple field selector */
357        | postfix_expression ARROW no_attr_identifier
358                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::PFieldSel), $1,
359                                             new VarRefNode($3)); }
360        | postfix_expression ARROW '[' push field_list pop ']' /* CFA, tuple field selector */
361        | postfix_expression ICR
362                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::IncrPost), $1); }
363        | postfix_expression DECR
364                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::DecrPost), $1); }
365                /* GCC has priority: cast_expression */
366        | '(' type_name_no_function ')' '{' initializer_list comma_opt '}' /* ANSI99 */
367                { $$ = 0; }
368        ;
369
370argument_expression_list:
371        argument_expression
372        | argument_expression_list ',' argument_expression
373                                                { $$ = (ExpressionNode *)($1->set_link($3)); }
374        ;
375
376argument_expression:
377        /* empty */                                     /* use default argument */
378                { $$ = 0; }
379        | assignment_expression
380        | no_attr_identifier ':' assignment_expression
381                                                { $$ = $3->set_asArgName($1); }
382                /* Only a list of no_attr_identifier_or_typedef_name is allowed in this context. However, there
383                   is insufficient look ahead to distinguish between this list of parameter names and a tuple,
384                   so the tuple form must be used with an appropriate semantic check. */
385        | '[' push assignment_expression pop ']' ':' assignment_expression
386                                                { $$ = $7->set_asArgName($3); }
387        | '[' push assignment_expression ',' tuple_expression_list pop ']' ':' assignment_expression
388                                                { $$ = $9->set_asArgName(new CompositeExprNode( new OperatorNode( OperatorNode::TupleC ), (ExpressionNode *)$3->set_link( flattenCommas( $5 )))); }
389        ;
390
391field_list:                                             /* CFA, tuple field selector */
392        field
393        | field_list ',' field                  { $$ = (ExpressionNode *)$1->set_link( $3 ); }
394        ;
395
396field:                                                  /* CFA, tuple field selector */
397        no_attr_identifier
398                                                { $$ = new VarRefNode( $1 ); }
399        | no_attr_identifier '.' field
400                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::FieldSel), new VarRefNode( $1 ), $3); }
401        | no_attr_identifier '.' '[' push field_list pop ']'
402                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::FieldSel), new VarRefNode( $1 ), $5); }
403        | no_attr_identifier ARROW field
404                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::PFieldSel), new VarRefNode( $1 ), $3); }
405        | no_attr_identifier ARROW '[' push field_list pop ']'
406                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::PFieldSel), new VarRefNode( $1 ), $5); }
407        ;
408
409unary_expression:
410        postfix_expression
411        | ICR unary_expression
412                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Incr), $2); }
413        | DECR unary_expression
414                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Decr), $2); }
415        | EXTENSION cast_expression                     /* GCC */
416                { $$ = $2; }
417        | unary_operator cast_expression
418                { $$ = new CompositeExprNode($1, $2); }
419        | '!' cast_expression
420                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Neg), $2); }
421        | '*' cast_expression                           /* CFA */
422                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::PointTo), $2); }
423                /* '*' is is separated from unary_operator because of shift/reduce conflict in:
424                        { * X; } // dereference X
425                        { * int X; } // CFA declaration of pointer to int
426                   '&' must be moved here if C++ reference variables are supported. */
427        | SIZEOF unary_expression
428                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::SizeOf), $2); }
429        | SIZEOF '(' type_name_no_function ')'
430                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::SizeOf), new TypeValueNode($3)); }
431        | ATTR_IDENTIFIER
432                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Attr), new VarRefNode($1)); }
433        | ATTR_IDENTIFIER '(' type_name ')'
434                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Attr), new VarRefNode($1), new TypeValueNode($3)); }
435        | ATTR_IDENTIFIER '(' argument_expression ')'
436                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Attr), new VarRefNode($1), $3); }
437        | ALIGNOF unary_expression                      /* GCC, variable alignment */
438                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::AlignOf), $2); }
439        | ALIGNOF '(' type_name_no_function ')'         /* GCC, type alignment */
440                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::AlignOf), new TypeValueNode($3)); }
441        | ANDAND no_attr_identifier                     /* GCC, address of label */
442                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::LabelAddress),
443                                             new VarRefNode($2, true)); }
444        ;
445
446unary_operator:
447        '&'                               { $$ = new OperatorNode(OperatorNode::AddressOf); }
448        | '+'                             { $$ = new OperatorNode(OperatorNode::UnPlus); }
449        | '-'                             { $$ = new OperatorNode(OperatorNode::UnMinus); }
450        | '~'                             { $$ = new OperatorNode(OperatorNode::BitNeg); }
451        ;
452
453cast_expression:
454        unary_expression
455        | '(' type_name_no_function ')' cast_expression
456                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Cast),
457                                                                       new TypeValueNode($2), $4); }
458        | '(' type_name_no_function ')' tuple
459                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Cast),
460                                                                       new TypeValueNode($2), $4); }
461        ;
462
463multiplicative_expression:
464        cast_expression
465        | multiplicative_expression '*' cast_expression
466                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Mul),$1,$3); }
467        | multiplicative_expression '/' cast_expression
468                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Div),$1,$3); }
469        | multiplicative_expression '%' cast_expression
470                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Mod),$1,$3); }
471        ;
472
473additive_expression:
474        multiplicative_expression
475        | additive_expression '+' multiplicative_expression
476                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Plus),$1,$3); }
477        | additive_expression '-' multiplicative_expression
478                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Minus),$1,$3); }
479        ;
480
481shift_expression:
482        additive_expression
483        | shift_expression LS additive_expression
484                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::LShift),$1,$3); }
485        | shift_expression RS additive_expression
486                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::RShift),$1,$3); }
487        ;
488
489relational_expression:
490        shift_expression
491        | relational_expression '<' shift_expression
492                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::LThan),$1,$3); }
493        | relational_expression '>' shift_expression
494                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::GThan),$1,$3); }
495        | relational_expression LE shift_expression
496                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::LEThan),$1,$3); }
497        | relational_expression GE shift_expression
498                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::GEThan),$1,$3); }
499        ;
500
501equality_expression:
502        relational_expression
503        | equality_expression EQ relational_expression
504                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Eq), $1, $3); }
505        | equality_expression NE relational_expression
506                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Neq), $1, $3); }
507        ;
508
509AND_expression:
510        equality_expression
511        | AND_expression '&' equality_expression
512                                                { $$ =new CompositeExprNode(new OperatorNode(OperatorNode::BitAnd), $1, $3); }
513        ;
514
515exclusive_OR_expression:
516        AND_expression
517        | exclusive_OR_expression '^' AND_expression
518                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Xor), $1, $3); }
519        ;
520
521inclusive_OR_expression:
522        exclusive_OR_expression
523        | inclusive_OR_expression '|' exclusive_OR_expression
524                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::BitOr), $1, $3); }
525        ;
526
527logical_AND_expression:
528        inclusive_OR_expression
529        | logical_AND_expression ANDAND inclusive_OR_expression
530                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::And), $1, $3); }
531        ;
532
533logical_OR_expression:
534        logical_AND_expression
535        | logical_OR_expression OROR logical_AND_expression
536                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Or), $1, $3); }
537        ;
538
539conditional_expression:
540        logical_OR_expression
541        | logical_OR_expression '?' comma_expression ':' conditional_expression
542                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Cond),
543                                                                       (ExpressionNode *)mkList((*$1,*$3,*$5))); }
544        | logical_OR_expression '?' /* empty */ ':' conditional_expression /* GCC, omitted first operand */
545                                                { $$=new CompositeExprNode(new OperatorNode(OperatorNode::NCond),$1,$4); }
546        | logical_OR_expression '?' comma_expression ':' tuple /* CFA, tuple expression */
547                                                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Cond),
548                                                                       (ExpressionNode *)mkList(( *$1, *$3, *$5 ))); }
549        ;
550
551constant_expression:
552        conditional_expression
553        ;
554
555assignment_expression:
556                /* CFA, assignment is separated from assignment_operator to ensure no assignment operations
557                   for tuples */
558        conditional_expression
559        | unary_expression '=' assignment_expression
560                                                { $$ =new CompositeExprNode(new OperatorNode(OperatorNode::Assign), $1, $3); }
561        | unary_expression assignment_operator assignment_expression
562                                                { $$ =new CompositeExprNode($2, $1, $3); }
563        | tuple assignment_opt                          /* CFA, tuple expression */
564                {
565                  if( $2 == 0 ) {
566                    $$ = $1;
567                  } else {
568                    $$ = new CompositeExprNode( new OperatorNode( OperatorNode::Assign ), $1, $2 );
569                  }
570                }
571        ;
572
573assignment_expression_opt:
574        /* empty */
575                { $$ = new NullExprNode; }
576        | assignment_expression
577        ;
578
579tuple:                                                  /* CFA, tuple */
580                /* CFA, one assignment_expression is factored out of comma_expression to eliminate a
581                   shift/reduce conflict with comma_expression in new_identifier_parameter_array and
582                   new_abstract_array */
583        '[' push pop ']'
584                { $$ = new CompositeExprNode( new OperatorNode( OperatorNode::TupleC ) ); }
585        | '[' push assignment_expression pop ']'
586                { $$ = new CompositeExprNode( new OperatorNode( OperatorNode::TupleC ), $3 ); }
587        | '[' push ',' tuple_expression_list pop ']'
588                { $$ = new CompositeExprNode( new OperatorNode( OperatorNode::TupleC ), (ExpressionNode *)(new NullExprNode)->set_link( $4 ) ); }
589        | '[' push assignment_expression ',' tuple_expression_list pop ']'
590                { $$ = new CompositeExprNode( new OperatorNode( OperatorNode::TupleC ), (ExpressionNode *)$3->set_link( flattenCommas( $5 ) ) ); }
591        ;
592
593tuple_expression_list:
594        assignment_expression_opt
595        | tuple_expression_list ',' assignment_expression_opt
596                { $$ = (ExpressionNode *)$1->set_link( $3 ); }
597        ;
598
599assignment_operator:
600        MULTassign                                      { $$ = new OperatorNode(OperatorNode::MulAssn);   }
601        | DIVassign                                     { $$ = new OperatorNode(OperatorNode::DivAssn);   }
602        | MODassign                                     { $$ = new OperatorNode(OperatorNode::ModAssn);   }
603        | PLUSassign                                    { $$ = new OperatorNode(OperatorNode::PlusAssn);  }
604        | MINUSassign                                   { $$ = new OperatorNode(OperatorNode::MinusAssn); }
605        | LSassign                                      { $$ = new OperatorNode(OperatorNode::LSAssn);    }
606        | RSassign                                      { $$ = new OperatorNode(OperatorNode::RSAssn);    }
607        | ANDassign                                     { $$ = new OperatorNode(OperatorNode::AndAssn);   }
608        | ERassign                                      { $$ = new OperatorNode(OperatorNode::ERAssn);    }
609        | ORassign                                      { $$ = new OperatorNode(OperatorNode::OrAssn);    }
610        ;
611
612comma_expression:
613        assignment_expression
614        | comma_expression ',' assignment_expression    /* { $$ = (ExpressionNode *)$1->add_to_list($3); } */
615                               { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Comma),$1,$3); }
616        ;
617
618comma_expression_opt:
619        /* empty */                                     { $$ = 0; }
620        | comma_expression
621        ;
622
623/*************************** STATEMENTS *******************************/
624
625statement:
626        labeled_statement
627        | compound_statement
628        | expression_statement                          { $$ = $1; }
629        | selection_statement
630        | iteration_statement
631        | jump_statement
632        | exception_statement
633        | asm_statement
634        ;
635
636labeled_statement:
637        no_attr_identifier ':' attribute_list_opt statement
638                { $$ = $4->add_label($1);}
639        ;
640
641compound_statement:
642        '{' '}'
643                { $$ = new CompoundStmtNode( (StatementNode *)0 ); }
644        | '{'
645                /* Two scopes are necessary because the block itself has a scope, but every declaration within
646                   the block also requires its own scope */
647          push push
648          label_declaration_opt                         /* GCC, local labels */
649          block_item_list pop '}'                       /* ANSI99, intermix declarations and statements */
650                { $$ = new CompoundStmtNode( $5 ); }
651        ;
652
653block_item_list:                                        /* ANSI99 */
654        block_item
655        | block_item_list push block_item
656                { if($1 != 0) { $1->set_link($3); $$ = $1; } }
657        ;
658
659block_item:
660        declaration                                     /* CFA, new & old style declarations */
661                { $$ = new StatementNode( $1 ); }
662        | EXTENSION declaration                         /* GCC */
663                { $$ = new StatementNode( $2 ); }
664        | statement pop
665        ;
666
667statement_list:
668        statement
669        | statement_list statement
670                { if($1 != 0) { $1->set_link($2); $$ = $1; } }
671        ;
672
673expression_statement:
674        comma_expression_opt ';'
675                { $$ = new StatementNode(StatementNode::Exp, $1, 0); }
676        ;
677
678selection_statement:
679        IF '(' comma_expression ')' statement           %prec THEN
680                /* explicitly deal with the shift/reduce conflict on if/else */
681                { $$ = new StatementNode(StatementNode::If, $3, $5); }
682        | IF '(' comma_expression ')' statement ELSE statement
683                { $$ = new StatementNode(StatementNode::If, $3, (StatementNode *)mkList((*$5, *$7)) ); }
684        | SWITCH '(' comma_expression ')' case_clause   /* CFA */
685                { $$ = new StatementNode(StatementNode::Switch, $3, $5); }
686        | SWITCH '(' comma_expression ')' '{' push declaration_list_opt switch_clause_list_opt '}' /* CFA */
687                { $$ = new StatementNode(StatementNode::Switch, $3, $8); /* xxx */ }
688                /* The semantics of the declaration list is changed to include any associated initialization,
689                   which is performed *before* the transfer to the appropriate case clause.  Statements after
690                   the initial declaration list can never be executed, and therefore, are removed from the
691                   grammar even though C allows it. */
692        | CHOOSE '(' comma_expression ')' case_clause   /* CFA */
693                { $$ = new StatementNode(StatementNode::Choose, $3, $5); }
694        | CHOOSE '(' comma_expression ')' '{' push declaration_list_opt choose_clause_list_opt '}' /* CFA */
695                { $$ = new StatementNode(StatementNode::Choose, $3, $8); }
696        ;
697
698/* CASE and DEFAULT clauses are only allowed in the SWITCH statement, precluding Duff's device. In addition, a
699   case clause allows a list of values and subranges. */
700
701case_value:                                             /* CFA */
702        constant_expression                     { $$ = $1; }
703        | constant_expression ELLIPSIS constant_expression /* GCC, subrange */
704                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Range),$1,$3); }
705        | subrange                                      /* CFA, subrange */
706        ;
707
708case_value_list:                                        /* CFA */
709        case_value
710        | case_value_list ',' case_value
711                {  $$ = new CompositeExprNode(new OperatorNode( OperatorNode::TupleC ), (ExpressionNode *)(tupleContents($1))->set_link($3) ); }
712        ;
713
714case_label:                                             /* CFA */
715        CASE case_value_list ':'                {  $$ = new StatementNode(StatementNode::Case, $2, 0); }
716        | DEFAULT ':'                           {  $$ = new StatementNode(StatementNode::Default);     }
717                /* A semantic check is required to ensure only one default clause per switch/choose
718                   statement. */
719        ;
720
721case_label_list:                                        /* CFA */
722        case_label
723        | case_label_list case_label            { $$ = (StatementNode *)($1->set_link($2)); }
724        ;
725
726case_clause:                                            /* CFA */
727        case_label_list statement               {  $$ = $1->append_last_case($2); }
728        ;
729
730switch_clause_list_opt:                                 /* CFA */
731        /* empty */                             { $$ = 0; }
732        | switch_clause_list
733        ;
734
735switch_clause_list:                                     /* CFA */
736        case_label_list statement_list
737                                                { $$ = $1->append_last_case($2); }
738        | switch_clause_list case_label_list statement_list
739                                                { $$ = (StatementNode *)($1->set_link($2->append_last_case($3))); }
740        ;
741
742choose_clause_list_opt:                                 /* CFA */
743        /* empty */                             { $$ = 0; }
744        | choose_clause_list
745        ;
746
747choose_clause_list:                                     /* CFA */
748        case_label_list fall_through
749                  { $$ = $1->append_last_case($2); }
750        | case_label_list statement_list fall_through_opt
751                  { $$ = $1->append_last_case((StatementNode *)mkList((*$2,*$3))); }
752        | choose_clause_list case_label_list fall_through
753                  { $$ = (StatementNode *)($1->set_link($2->append_last_case($3))); }
754        | choose_clause_list case_label_list statement_list fall_through_opt
755                  { $$ = (StatementNode *)($1->set_link($2->append_last_case((StatementNode *)mkList((*$3,*$4))))); }
756        ;
757
758fall_through_opt:                                       /* CFA */
759        /* empty */                             { $$ = 0; }
760        | fall_through
761        ;
762
763fall_through:                                           /* CFA */
764        FALLTHRU                                { $$ = new StatementNode(StatementNode::Fallthru, 0, 0); }
765        | FALLTHRU ';'                          { $$ = new StatementNode(StatementNode::Fallthru, 0, 0); }
766        ;
767
768iteration_statement:
769        WHILE '(' comma_expression ')' statement
770                                                { $$ = new StatementNode(StatementNode::While, $3, $5); }
771        | DO statement WHILE '(' comma_expression ')' ';'
772                                                { $$ = new StatementNode(StatementNode::Do, $5, $2); }
773        | FOR '(' push for_control_expression ')' statement
774                                                { $$ = new StatementNode(StatementNode::For, $4, $6); }
775        ;
776
777for_control_expression:
778        comma_expression_opt pop ';' comma_expression_opt ';' comma_expression_opt
779                                                { $$ = new ForCtlExprNode($1, $4, $6); }
780        | declaration comma_expression_opt ';' comma_expression_opt /* ANSI99 */
781                /* Like C++, the loop index can be declared local to the loop. */
782                                                { $$ = new ForCtlExprNode($1, $2, $4); }
783        ;
784
785jump_statement:
786        GOTO no_attr_identifier ';'
787                                                { $$ = new StatementNode(StatementNode::Goto, $2); }
788        | GOTO '*' comma_expression ';'         /* GCC, computed goto */
789                /* The syntax for the GCC computed goto violates normal expression precedence, e.g.,
790                   goto *i+3; => goto *(i+3); whereas normal operator precedence yields goto (*i)+3; */
791                                                { $$ = new StatementNode(StatementNode::Goto, $3); }
792        | CONTINUE ';'
793                /* A semantic check is required to ensure this statement appears only in the body of an
794                   iteration statement. */
795                                                { $$ = new StatementNode(StatementNode::Continue, 0, 0); }
796        | CONTINUE no_attr_identifier ';'       /* CFA, multi-level continue */
797                /* A semantic check is required to ensure this statement appears only in the body of an
798                   iteration statement, and the target of the transfer appears only at the start of an
799                   iteration statement. */
800                                                { $$ = new StatementNode(StatementNode::Continue, $2); }
801        | BREAK ';'
802                /* A semantic check is required to ensure this statement appears only in the body of an
803                   iteration statement. */
804                                                { $$ = new StatementNode(StatementNode::Break, 0, 0); }
805        | BREAK no_attr_identifier ';'  /* CFA, multi-level exit */
806                /* A semantic check is required to ensure this statement appears only in the body of an
807                   iteration statement, and the target of the transfer appears only at the start of an
808                   iteration statement. */
809                                                { $$ = new StatementNode(StatementNode::Break, $2 ); }
810        | RETURN comma_expression_opt ';'
811                                                { $$ = new StatementNode(StatementNode::Return, $2, 0); }
812        | THROW assignment_expression ';'
813                                                { $$ = new StatementNode(StatementNode::Throw, $2, 0); }
814        | THROW ';'
815                                                { $$ = new StatementNode(StatementNode::Throw, 0, 0); }
816        ;
817
818exception_statement:
819        TRY compound_statement handler_list
820                             { $$ = new StatementNode(StatementNode::Try, 0,(StatementNode *)(mkList((*$2,*$3)))); }
821        | TRY compound_statement finally_clause
822                             { $$ = new StatementNode(StatementNode::Try, 0,(StatementNode *)(mkList((*$2,*$3)))); }
823        | TRY compound_statement handler_list finally_clause
824                             {
825                               $3->set_link($4);
826                               $$ = new StatementNode(StatementNode::Try, 0,(StatementNode *)(mkList((*$2,*$3))));
827                             }
828        ;
829
830handler_list:
831                /* There must be at least one catch clause */
832        handler_clause
833                /* ISO/IEC 9899:1999 Section 15.3(6) If present, a "..." handler shall be the last handler for
834                   its try block. */
835        | CATCH '(' ELLIPSIS ')' compound_statement
836                                                { $$ = StatementNode::newCatchStmt( 0, $5, true ); }
837        | handler_clause CATCH '(' ELLIPSIS ')' compound_statement
838                                                { $$ = $1->set_link( StatementNode::newCatchStmt( 0, $6, true ) ); }
839        ;
840
841handler_clause:
842        CATCH '(' push push exception_declaration pop ')' compound_statement pop
843                                                { $$ = StatementNode::newCatchStmt($5, $8); }
844        | handler_clause CATCH '(' push push exception_declaration pop ')' compound_statement pop
845                                                { $$ = $1->set_link( StatementNode::newCatchStmt($6, $9) );   }
846        ;
847
848finally_clause:
849        FINALLY compound_statement
850                                                { $$ = new StatementNode(StatementNode::Finally, 0, $2);
851                                                  std::cout << "Just created a finally node" << std::endl;
852                                                }
853        ;
854
855exception_declaration:
856                /* A semantic check is required to ensure type_specifier does not create a new type, e.g.:
857
858                        catch ( struct { int i; } x ) ...
859
860                   This new type cannot catch any thrown type because of name equivalence among types. */
861        type_specifier
862        | type_specifier declarator
863                {
864                    typedefTable.addToEnclosingScope( TypedefTable::ID );
865                    $$ = $2->addType( $1 );
866                }
867        | type_specifier variable_abstract_declarator
868                {   $$ = $2->addType( $1 ); }
869        | new_abstract_declarator_tuple no_attr_identifier /* CFA */
870                {
871                    typedefTable.addToEnclosingScope( TypedefTable::ID );
872                    $$ = $1->addName( $2 );
873                }
874        | new_abstract_declarator_tuple                 /* CFA */
875        ;
876
877asm_statement:
878        ASM type_qualifier_list_opt '(' constant_expression ')' ';'
879                                                { $$ = new StatementNode(StatementNode::Asm, 0, 0); }
880        | ASM type_qualifier_list_opt '(' constant_expression ':' asm_operands_opt ')' ';' /* remaining GCC */
881                                                { $$ = new StatementNode(StatementNode::Asm, 0, 0); }
882        | ASM type_qualifier_list_opt '(' constant_expression ':' asm_operands_opt ':' asm_operands_opt ')' ';'
883                                                { $$ = new StatementNode(StatementNode::Asm, 0, 0); }
884        | ASM type_qualifier_list_opt '(' constant_expression ':' asm_operands_opt ':' asm_operands_opt ':'
885                        asm_clobbers_list ')' ';'
886                                                { $$ = new StatementNode(StatementNode::Asm, 0, 0); }
887        ;
888
889asm_operands_opt:                                       /* GCC */
890        /* empty */
891        | asm_operands_list
892        ;
893
894asm_operands_list:                                      /* GCC */
895        asm_operand
896        | asm_operands_list ',' asm_operand
897        ;
898
899asm_operand:                                            /* GCC */
900        STRINGliteral '(' constant_expression ')'       {}
901        ;
902
903asm_clobbers_list:                                      /* GCC */
904        STRINGliteral                           {}
905        | asm_clobbers_list ',' STRINGliteral
906        ;
907
908/******************************* DECLARATIONS *********************************/
909
910declaration_list_opt:                                   /* used at beginning of switch statement */
911        pop
912                { $$ = 0; }
913        | declaration_list
914        ;
915
916declaration_list:
917        declaration
918        | declaration_list push declaration
919                { $$ = $1->appendList( $3 ); }
920        ;
921
922old_declaration_list_opt:                               /* used to declare parameter types in K&R style functions */
923        pop
924                { $$ = 0; }
925        | old_declaration_list
926        ;
927
928old_declaration_list:
929        old_declaration
930        | old_declaration_list push old_declaration
931                { $$ = $1->appendList( $3 ); }
932        ;
933
934label_declaration_opt:                                  /* GCC, local label */
935        /* empty */
936        | label_declaration_list
937        ;
938
939label_declaration_list:                                 /* GCC, local label */
940        LABEL label_list ';'
941        | label_declaration_list LABEL label_list ';'
942        ;
943
944label_list:                                             /* GCC, local label */
945        no_attr_identifier_or_typedef_name              {}
946        | label_list ',' no_attr_identifier_or_typedef_name {}
947        ;
948
949declaration:                                            /* CFA, new & old style declarations */
950        new_declaration
951        | old_declaration
952        ;
953
954/* C declaration syntax is notoriously confusing and error prone. Cforall provides its own type, variable and
955   function declarations. CFA declarations use the same declaration tokens as in C; however, CFA places
956   declaration modifiers to the left of the base type, while C declarations place modifiers to the right of
957   the base type. CFA declaration modifiers are interpreted from left to right and the entire type
958   specification is distributed across all variables in the declaration list (as in Pascal).  ANSI C and the
959   new CFA declarations may appear together in the same program block, but cannot be mixed within a specific
960   declaration.
961
962            CFA             C
963        [10] int x;     int x[10];      // array of 10 integers
964        [10] * char y;  char *y[10];    // array of 10 pointers to char
965   */
966
967new_declaration:                                        /* CFA */
968        new_variable_declaration pop ';'
969        | new_typedef_declaration pop ';'
970        | new_function_declaration pop ';'
971        | type_declaring_list pop ';'
972        | context_specifier pop ';'
973        ;
974
975new_variable_declaration:                               /* CFA */
976        new_variable_specifier initializer_opt
977                {
978                        typedefTable.addToEnclosingScope( TypedefTable::ID);
979                        $$ = $1;
980                }
981        | declaration_qualifier_list new_variable_specifier initializer_opt
982                /* declaration_qualifier_list also includes type_qualifier_list, so a semantic check is
983                   necessary to preclude them as a type_qualifier cannot appear in that context. */
984                {
985                        typedefTable.addToEnclosingScope( TypedefTable::ID);
986                        $$ = $2->addQualifiers( $1 );
987                }
988        | new_variable_declaration pop ',' push identifier_or_typedef_name initializer_opt
989                {
990                        typedefTable.addToEnclosingScope( *$5, TypedefTable::ID);
991                        $$ = $1->appendList( $1->cloneType( $5 ) );
992                }
993        ;
994
995new_variable_specifier:                                 /* CFA */
996                /* A semantic check is required to ensure asm_name only appears on declarations with implicit
997                   or explicit static storage-class */
998        new_abstract_declarator_no_tuple identifier_or_typedef_name asm_name_opt
999                {
1000                        typedefTable.setNextIdentifier( *$2 );
1001                        $$ = $1->addName( $2 );
1002                }
1003        | new_abstract_tuple identifier_or_typedef_name asm_name_opt
1004                {
1005                        typedefTable.setNextIdentifier( *$2 );
1006                        $$ = $1->addName( $2 );
1007                }
1008        | type_qualifier_list new_abstract_tuple identifier_or_typedef_name asm_name_opt
1009                {
1010                        typedefTable.setNextIdentifier( *$3 );
1011                        $$ = $2->addQualifiers( $1 )->addName( $3 );
1012                }
1013        ;
1014
1015new_function_declaration:                               /* CFA */
1016        new_function_specifier
1017                {
1018                        typedefTable.addToEnclosingScope( TypedefTable::ID);
1019                        $$ = $1;
1020                }
1021        | declaration_qualifier_list new_function_specifier
1022                /* declaration_qualifier_list also includes type_qualifier_list, so a semantic check is
1023                   necessary to preclude them as a type_qualifier cannot appear in this context. */
1024                {
1025                        typedefTable.addToEnclosingScope( TypedefTable::ID);
1026                        $$ = $2->addQualifiers( $1 );
1027                }
1028        | new_function_declaration pop ',' push identifier_or_typedef_name
1029                {
1030                        typedefTable.addToEnclosingScope( *$5, TypedefTable::ID);
1031                        $$ = $1->appendList( $1->cloneType( $5 ) );
1032                }
1033        ;
1034
1035new_function_specifier:                                 /* CFA */
1036        '[' push pop ']' identifier '(' push new_parameter_type_list_opt pop ')'
1037                {
1038                        typedefTable.setNextIdentifier( *($5) );
1039                        $$ = DeclarationNode::newFunction( $5, DeclarationNode::newTuple( 0 ), $8, 0, true );
1040                }
1041        | '[' push pop ']' TYPEDEFname '(' push new_parameter_type_list_opt pop ')'
1042                {
1043                        typedefTable.setNextIdentifier( *($5) );
1044                        $$ = DeclarationNode::newFunction( $5, DeclarationNode::newTuple( 0 ), $8, 0, true );
1045                }
1046                /* identifier_or_typedef_name must be broken apart because of the sequence:
1047
1048                   '[' ']' identifier_or_typedef_name '(' new_parameter_type_list_opt ')'
1049                   '[' ']' type_specifier
1050
1051                   type_specifier can resolve to just TYPEDEFname (e.g. typedef int T; int f( T );). Therefore
1052                   this must be flattened to allow lookahead to the '(' without having to reduce
1053                   identifier_or_typedef_name. */
1054        | new_abstract_tuple identifier_or_typedef_name '(' push new_parameter_type_list_opt pop ')'
1055                /* To obtain LR(1), this rule must be factored out from function return type (see
1056                   new_abstract_declarator). */
1057                {
1058                        $$ = DeclarationNode::newFunction( $2, $1, $5, 0, true );
1059                }
1060        | new_function_return identifier_or_typedef_name '(' push new_parameter_type_list_opt pop ')'
1061                {
1062                        $$ = DeclarationNode::newFunction( $2, $1, $5, 0, true );
1063                }
1064        ;
1065
1066new_function_return:                                    /* CFA */
1067        '[' push new_parameter_list pop ']'
1068                { $$ = DeclarationNode::newTuple( $3 ); }
1069        | '[' push new_parameter_list pop ',' push new_abstract_parameter_list pop ']'
1070                /* To obtain LR(1), the last new_abstract_parameter_list is added into this flattened rule to
1071                   lookahead to the ']'. */
1072                { $$ = DeclarationNode::newTuple( $3->appendList( $7 ) ); }
1073        ;
1074
1075new_typedef_declaration:                                /* CFA */
1076        TYPEDEF new_variable_specifier
1077                {
1078                        typedefTable.addToEnclosingScope( TypedefTable::TD);
1079                        $$ = $2->addTypedef();
1080                }
1081        | TYPEDEF new_function_specifier
1082                {
1083                        typedefTable.addToEnclosingScope( TypedefTable::TD);
1084                        $$ = $2->addTypedef();
1085                }
1086        | new_typedef_declaration pop ',' push no_attr_identifier
1087                {
1088                        typedefTable.addToEnclosingScope( *$5, TypedefTable::TD);
1089                        $$ = $1->appendList( $1->cloneType( $5 ) );
1090                }
1091        ;
1092
1093/* Traditionally typedef is part of storage-class specifier for syntactic convenience only. Here, it is
1094   factored out as a separate form of declaration, which syntactically precludes storage-class specifiers and
1095   initialization. */
1096
1097typedef_declaration:
1098        TYPEDEF type_specifier declarator
1099                {
1100                        typedefTable.addToEnclosingScope( TypedefTable::TD);
1101                        $$ = $3->addType( $2 )->addTypedef();
1102                }
1103        | typedef_declaration pop ',' push declarator
1104                {
1105                        typedefTable.addToEnclosingScope( TypedefTable::TD);
1106                        $$ = $1->appendList( $1->cloneBaseType( $5 )->addTypedef() );
1107                }
1108        | type_qualifier_list TYPEDEF type_specifier declarator /* remaining OBSOLESCENT (see 2) */
1109                {
1110                        typedefTable.addToEnclosingScope( TypedefTable::TD);
1111                        $$ = $4->addType( $3 )->addQualifiers( $1 )->addTypedef();
1112                }
1113        | type_specifier TYPEDEF declarator
1114                {
1115                        typedefTable.addToEnclosingScope( TypedefTable::TD);
1116                        $$ = $3->addType( $1 )->addTypedef();
1117                }
1118        | type_specifier TYPEDEF type_qualifier_list declarator
1119                {
1120                        typedefTable.addToEnclosingScope( TypedefTable::TD);
1121                        $$ = $4->addQualifiers($1)->addTypedef()->addType($1);
1122                }
1123        ;
1124
1125typedef_expression:                                     /* GCC, naming expression type */
1126        TYPEDEF no_attr_identifier '=' assignment_expression
1127                {
1128                        typedefTable.addToEnclosingScope(*($2), TypedefTable::TD);
1129                        $$ = DeclarationNode::newName( 0 ); // XXX
1130                }
1131        | typedef_expression pop ',' push no_attr_identifier '=' assignment_expression
1132                {
1133                        typedefTable.addToEnclosingScope(*($5), TypedefTable::TD);
1134                        $$ = DeclarationNode::newName( 0 ); // XXX
1135                }
1136        ;
1137
1138old_declaration:
1139        declaring_list pop ';'
1140        | typedef_declaration pop ';'
1141        | typedef_expression pop ';'                    /* GCC, naming expression type */
1142        | sue_declaration_specifier pop ';'
1143        ;
1144
1145declaring_list:
1146                /* A semantic check is required to ensure asm_name only appears on declarations with implicit
1147                   or explicit static storage-class */
1148        declaration_specifier declarator asm_name_opt initializer_opt
1149                {
1150                        typedefTable.addToEnclosingScope( TypedefTable::ID);
1151                        $$ = ($2->addType( $1 ))->addInitializer($4);
1152                }
1153        | declaring_list ',' attribute_list_opt declarator asm_name_opt initializer_opt
1154                {
1155                        typedefTable.addToEnclosingScope( TypedefTable::ID);
1156                        $$ = $1->appendList( $1->cloneBaseType( $4->addInitializer($6) ) );
1157                }
1158        ;
1159
1160declaration_specifier:                                  /* type specifier + storage class */
1161        basic_declaration_specifier
1162        | sue_declaration_specifier
1163        | typedef_declaration_specifier
1164        | typegen_declaration_specifier
1165        ;
1166
1167type_specifier:                                         /* declaration specifier - storage class */
1168        basic_type_specifier
1169        | sue_type_specifier
1170        | typedef_type_specifier
1171        | typegen_type_specifier
1172        ;
1173
1174type_qualifier_list_opt:                                /* GCC, used in asm_statement */
1175        /* empty */
1176                { $$ = 0; }
1177        | type_qualifier_list
1178        ;
1179
1180type_qualifier_list:
1181                /* A semantic check is necessary to ensure a type qualifier is appropriate for the kind of
1182                   declaration.
1183
1184                   ISO/IEC 9899:1999 Section 6.7.3(4) : If the same qualifier appears more than once in the
1185                   same specifier-qualifier-list, either directly or via one or more typedefs, the behavior is
1186                   the same as if it appeared only once. */
1187        type_qualifier
1188        | type_qualifier_list type_qualifier
1189                { $$ = $1->addQualifiers( $2 ); }
1190        ;
1191
1192type_qualifier:
1193        type_qualifier_name
1194        | attribute
1195                { $$ = DeclarationNode::newQualifier( DeclarationNode::Const ); }
1196        ;
1197
1198type_qualifier_name:
1199        CONST
1200                { $$ = DeclarationNode::newQualifier( DeclarationNode::Const ); }
1201        | RESTRICT
1202                { $$ = DeclarationNode::newQualifier( DeclarationNode::Restrict ); }
1203        | VOLATILE
1204                { $$ = DeclarationNode::newQualifier( DeclarationNode::Volatile ); }
1205        | LVALUE                                        /* CFA */
1206                { $$ = DeclarationNode::newQualifier( DeclarationNode::Lvalue ); }
1207        | FORALL '('
1208                {
1209                        typedefTable.enterScope();
1210                }
1211          type_parameter_list ')'               /* CFA */
1212                {
1213                        typedefTable.leaveScope();
1214                        $$ = DeclarationNode::newForall( $4 );
1215                }
1216        ;
1217
1218declaration_qualifier_list:
1219        storage_class_list
1220        | type_qualifier_list storage_class_list        /* remaining OBSOLESCENT (see 2) */
1221                { $$ = $1->addQualifiers( $2 ); }
1222        | declaration_qualifier_list type_qualifier_list storage_class_list
1223                { $$ = $1->addQualifiers( $2 )->addQualifiers( $3 ); }
1224        ;
1225
1226storage_class_list:
1227                /* A semantic check is necessary to ensure a storage class is appropriate for the kind of
1228                   declaration and that only one of each is specified, except for inline, which can appear
1229                   with the others.
1230
1231                   ISO/IEC 9899:1999 Section 6.7.1(2) : At most, one storage-class specifier may be given in
1232                   the declaration specifiers in a declaration. */
1233        storage_class
1234        | storage_class_list storage_class
1235                { $$ = $1->addQualifiers( $2 ); }
1236        ;
1237
1238storage_class:
1239        storage_class_name
1240        ;
1241
1242storage_class_name:
1243        AUTO
1244                { $$ = DeclarationNode::newStorageClass( DeclarationNode::Auto ); }
1245        | EXTERN
1246                { $$ = DeclarationNode::newStorageClass( DeclarationNode::Extern ); }
1247        | REGISTER
1248                { $$ = DeclarationNode::newStorageClass( DeclarationNode::Register ); }
1249        | STATIC
1250                { $$ = DeclarationNode::newStorageClass( DeclarationNode::Static ); }
1251        | INLINE                                        /* ANSI99 */
1252                /* INLINE is essentially a storage class specifier for functions, and hence, belongs here. */
1253                { $$ = DeclarationNode::newStorageClass( DeclarationNode::Inline ); }
1254        | FORTRAN                                       /* ANSI99 */
1255                { $$ = DeclarationNode::newStorageClass( DeclarationNode::Fortran ); }
1256        ;
1257
1258basic_type_name:
1259        CHAR
1260                { $$ = DeclarationNode::newBasicType( DeclarationNode::Char ); }
1261        | DOUBLE
1262                { $$ = DeclarationNode::newBasicType( DeclarationNode::Double ); }
1263        | FLOAT
1264                { $$ = DeclarationNode::newBasicType( DeclarationNode::Float ); }
1265        | INT
1266                { $$ = DeclarationNode::newBasicType( DeclarationNode::Int ); }
1267        | LONG
1268                { $$ = DeclarationNode::newModifier( DeclarationNode::Long ); }
1269        | SHORT
1270                { $$ = DeclarationNode::newModifier( DeclarationNode::Short ); }
1271        | SIGNED
1272                { $$ = DeclarationNode::newModifier( DeclarationNode::Signed ); }
1273        | UNSIGNED
1274                { $$ = DeclarationNode::newModifier( DeclarationNode::Unsigned ); }
1275        | VOID
1276                { $$ = DeclarationNode::newBasicType( DeclarationNode::Void ); }
1277        | BOOL                                          /* ANSI99 */
1278                { $$ = DeclarationNode::newBasicType( DeclarationNode::Bool ); }
1279        | COMPLEX                                       /* ANSI99 */
1280                { $$ = DeclarationNode::newBasicType( DeclarationNode::Complex ); }
1281        | IMAGINARY                                     /* ANSI99 */
1282                { $$ = DeclarationNode::newBasicType( DeclarationNode::Imaginary ); }
1283        ;
1284
1285basic_declaration_specifier:
1286                /* A semantic check is necessary for conflicting storage classes. */
1287        basic_type_specifier
1288        | declaration_qualifier_list basic_type_specifier
1289                { $$ = $2->addQualifiers( $1 ); }
1290        | basic_declaration_specifier storage_class     /* remaining OBSOLESCENT (see 2) */
1291                { $$ = $1->addQualifiers( $2 ); }
1292        | basic_declaration_specifier storage_class type_qualifier_list
1293                { $$ = $1->addQualifiers( $2 )->addQualifiers( $3 ); }
1294        | basic_declaration_specifier storage_class basic_type_specifier
1295                { $$ = $3->addQualifiers( $2 )->addType( $1 ); }
1296        ;
1297
1298basic_type_specifier:
1299        direct_type_name
1300        | type_qualifier_list_opt indirect_type_name type_qualifier_list_opt
1301                { $$ = $2->addQualifiers( $1 )->addQualifiers( $3 ); }
1302        ;
1303
1304direct_type_name:
1305                /* A semantic check is necessary for conflicting type qualifiers. */
1306        basic_type_name
1307        | type_qualifier_list basic_type_name
1308                { $$ = $2->addQualifiers( $1 ); }
1309        | direct_type_name type_qualifier
1310                { $$ = $1->addQualifiers( $2 ); }
1311        | direct_type_name basic_type_name
1312                { $$ = $1->addType( $2 ); }
1313        ;
1314
1315indirect_type_name:
1316        TYPEOF '(' type_name ')'                        /* GCC: typeof(x) y; */
1317                { $$ = $3; }
1318        | TYPEOF '(' comma_expression ')'               /* GCC: typeof(a+b) y; */
1319                { $$ = DeclarationNode::newTypeof( $3 ); }
1320        | ATTR_TYPEGENname '(' type_name ')'            /* CFA: e.g., @type(x) y; */
1321                { $$ = DeclarationNode::newAttr( $1, $3 ); }
1322        | ATTR_TYPEGENname '(' comma_expression ')'     /* CFA: e.g., @type(a+b) y; */
1323                { $$ = DeclarationNode::newAttr( $1, $3 ); }
1324        ;
1325
1326sue_declaration_specifier:
1327        sue_type_specifier
1328        | declaration_qualifier_list sue_type_specifier
1329                { $$ = $2->addQualifiers( $1 ); }
1330        | sue_declaration_specifier storage_class       /* remaining OBSOLESCENT (see 2) */
1331                { $$ = $1->addQualifiers( $2 ); }
1332        | sue_declaration_specifier storage_class type_qualifier_list
1333                { $$ = $1->addQualifiers( $2 )->addQualifiers( $3 ); }
1334        ;
1335
1336sue_type_specifier:
1337        elaborated_type_name                            /* struct, union, enum */
1338        | type_qualifier_list elaborated_type_name
1339                { $$ = $2->addQualifiers( $1 ); }
1340        | sue_type_specifier type_qualifier
1341                { $$ = $1->addQualifiers( $2 ); }
1342        ;
1343
1344typedef_declaration_specifier:
1345        typedef_type_specifier
1346        | declaration_qualifier_list typedef_type_specifier
1347                { $$ = $2->addQualifiers( $1 ); }
1348        | typedef_declaration_specifier storage_class   /* remaining OBSOLESCENT (see 2) */
1349                { $$ = $1->addQualifiers( $2 ); }
1350        | typedef_declaration_specifier storage_class type_qualifier_list
1351                { $$ = $1->addQualifiers( $2 )->addQualifiers( $3 ); }
1352        ;
1353
1354typedef_type_specifier:                                 /* typedef types */
1355        TYPEDEFname
1356                { $$ = DeclarationNode::newFromTypedef( $1 ); }
1357        | type_qualifier_list TYPEDEFname
1358                { $$ = DeclarationNode::newFromTypedef( $2 )->addQualifiers( $1 ); }
1359        | typedef_type_specifier type_qualifier
1360                { $$ = $1->addQualifiers( $2 ); }
1361        ;
1362
1363elaborated_type_name:
1364        aggregate_name
1365        | enum_name
1366        ;
1367
1368aggregate_name:
1369        aggregate_key '{' field_declaration_list '}'
1370                { $$ = DeclarationNode::newAggregate( $1, 0, 0, 0, $3 ); }
1371        | aggregate_key no_attr_identifier_or_typedef_name
1372                { $$ = DeclarationNode::newAggregate( $1, $2, 0, 0, 0 ); }
1373        | aggregate_key no_attr_identifier_or_typedef_name '{' field_declaration_list '}'
1374                { $$ = DeclarationNode::newAggregate( $1, $2, 0, 0, $4 ); }
1375        | aggregate_key '(' push type_parameter_list pop ')' '{' field_declaration_list '}' /* CFA */
1376                { $$ = DeclarationNode::newAggregate( $1, 0, $4, 0, $8 ); }
1377        | aggregate_key '(' push type_parameter_list pop ')' no_attr_identifier_or_typedef_name /* CFA */
1378                { $$ = DeclarationNode::newAggregate( $1, $7, $4, 0, 0 ); }
1379        | aggregate_key '(' push type_parameter_list pop ')' no_attr_identifier_or_typedef_name '{' field_declaration_list '}' /* CFA */
1380                { $$ = DeclarationNode::newAggregate( $1, $7, $4, 0, $9 ); }
1381        | aggregate_key '(' push type_parameter_list pop ')' '(' type_name_list ')' '{' field_declaration_list '}' /* CFA */
1382                { $$ = DeclarationNode::newAggregate( $1, 0, $4, $8, $11 ); }
1383        | aggregate_key '(' push type_name_list pop ')' no_attr_identifier_or_typedef_name /* CFA */
1384                /* push and pop are only to prevent S/R conflicts */
1385                { $$ = DeclarationNode::newAggregate( $1, $7, 0, $4, 0 ); }
1386        | aggregate_key '(' push type_parameter_list pop ')' '(' type_name_list ')' no_attr_identifier_or_typedef_name '{' field_declaration_list '}' /* CFA */
1387                { $$ = DeclarationNode::newAggregate( $1, $10, $4, $8, $12 ); }
1388        ;
1389
1390aggregate_key:
1391        STRUCT attribute_list_opt
1392                { $$ = DeclarationNode::Struct; }
1393        | UNION attribute_list_opt
1394                { $$ = DeclarationNode::Union; }
1395        ;
1396
1397field_declaration_list:
1398        field_declaration
1399                { $$ = $1; }
1400        | field_declaration_list field_declaration
1401                { $$ = $1->appendList( $2 ); }
1402        ;
1403
1404field_declaration:
1405        new_field_declaring_list ';'                    /* CFA, new style field declaration */
1406        | EXTENSION new_field_declaring_list ';'        /* GCC */
1407                { $$ = $2; }
1408        | field_declaring_list ';'
1409        | EXTENSION field_declaring_list ';'            /* GCC */
1410                { $$ = $2; }
1411        ;
1412
1413new_field_declaring_list:                               /* CFA, new style field declaration */
1414        new_abstract_declarator_tuple                   /* CFA, no field name */
1415        | new_abstract_declarator_tuple no_attr_identifier_or_typedef_name
1416                { $$ = $1->addName( $2 ); }
1417        | new_field_declaring_list ',' no_attr_identifier_or_typedef_name
1418                { $$ = $1->appendList( $1->cloneType( $3 ) ); }
1419        | new_field_declaring_list ','                  /* CFA, no field name */
1420                { $$ = $1->appendList( $1->cloneType( 0 ) ); }
1421        ;
1422
1423field_declaring_list:
1424        type_specifier field_declarator
1425                { $$ = $2->addType( $1 ); }
1426        | field_declaring_list ',' attribute_list_opt field_declarator
1427                { $$ = $1->appendList( $1->cloneBaseType( $4 ) ); }
1428        ;
1429
1430field_declarator:
1431        /* empty */                                     /* CFA, no field name */
1432                { $$ = DeclarationNode::newName( 0 ); /* XXX */ }
1433        | bit_subrange_size                             /* no field name */
1434                { $$ = DeclarationNode::newBitfield( $1 ); }
1435        | variable_declarator bit_subrange_size_opt
1436                /* A semantic check is required to ensure bit_subrange only appears on base type int. */
1437                { $$ = $1->addBitfield( $2 ); }
1438        | typedef_redeclarator bit_subrange_size_opt
1439                /* A semantic check is required to ensure bit_subrange only appears on base type int. */
1440                { $$ = $1->addBitfield( $2 ); }
1441        | variable_abstract_declarator                  /* CFA, no field name */
1442        ;
1443
1444bit_subrange_size_opt:
1445        /* empty */
1446                { $$ = 0; }
1447        | bit_subrange_size
1448                { $$ = $1; }
1449        ;
1450
1451bit_subrange_size:
1452        ':' constant_expression
1453                { $$ = $2; }
1454        ;
1455
1456enum_key:
1457        ENUM attribute_list_opt
1458        ;
1459
1460enum_name:
1461        enum_key '{' enumerator_list comma_opt '}'
1462                { $$ = DeclarationNode::newEnum( 0, $3 ); }
1463        | enum_key no_attr_identifier_or_typedef_name '{' enumerator_list comma_opt '}'
1464                { $$ = DeclarationNode::newEnum( $2, $4 ); }
1465        | enum_key no_attr_identifier_or_typedef_name
1466                { $$ = DeclarationNode::newEnum( $2, 0 ); }
1467        ;
1468
1469enumerator_list:
1470        no_attr_identifier_or_typedef_name enumerator_value_opt
1471                { $$ = DeclarationNode::newEnumConstant( $1, $2 ); }
1472        | enumerator_list ',' no_attr_identifier_or_typedef_name enumerator_value_opt
1473                { $$ = $1->appendList( DeclarationNode::newEnumConstant( $3, $4 ) ); }
1474        ;
1475
1476enumerator_value_opt:
1477        /* empty */
1478                { $$ = 0; }
1479        | '=' constant_expression
1480                { $$ = $2; }
1481        ;
1482
1483/* Minimum of one parameter after which ellipsis is allowed only at the end. */
1484
1485new_parameter_type_list_opt:                            /* CFA */
1486        /* empty */
1487                { $$ = 0; }
1488        | new_parameter_type_list
1489        ;
1490
1491new_parameter_type_list:                                /* CFA, abstract + real */
1492        new_abstract_parameter_list
1493        | new_parameter_list
1494        | new_parameter_list pop ',' push new_abstract_parameter_list
1495                { $$ = $1->appendList( $5 ); }
1496        | new_abstract_parameter_list pop ',' push ELLIPSIS
1497                { $$ = $1->addVarArgs(); }
1498        | new_parameter_list pop ',' push ELLIPSIS
1499                { $$ = $1->addVarArgs(); }
1500        ;
1501
1502new_parameter_list:                                     /* CFA */
1503                /* To obtain LR(1) between new_parameter_list and new_abstract_tuple, the last
1504                   new_abstract_parameter_list is factored out from new_parameter_list, flattening the rules
1505                   to get lookahead to the ']'. */
1506        new_parameter_declaration
1507        | new_abstract_parameter_list pop ',' push new_parameter_declaration
1508                { $$ = $1->appendList( $5 ); }
1509        | new_parameter_list pop ',' push new_parameter_declaration
1510                { $$ = $1->appendList( $5 ); }
1511        | new_parameter_list pop ',' push new_abstract_parameter_list pop ',' push new_parameter_declaration
1512                { $$ = $1->appendList( $5 )->appendList( $9 ); }
1513        ;
1514
1515new_abstract_parameter_list:                            /* CFA, new & old style abstract */
1516        new_abstract_parameter_declaration
1517        | new_abstract_parameter_list pop ',' push new_abstract_parameter_declaration
1518                { $$ = $1->appendList( $5 ); }
1519        ;
1520
1521parameter_type_list_opt:
1522        /* empty */
1523                { $$ = 0; }
1524        | parameter_type_list
1525        ;
1526
1527parameter_type_list:
1528        parameter_list
1529        | parameter_list pop ',' push ELLIPSIS
1530                { $$ = $1->addVarArgs(); }
1531        ;
1532
1533parameter_list:                                         /* abstract + real */
1534        abstract_parameter_declaration
1535        | parameter_declaration
1536        | parameter_list pop ',' push abstract_parameter_declaration
1537                { $$ = $1->appendList( $5 ); }
1538        | parameter_list pop ',' push parameter_declaration
1539                { $$ = $1->appendList( $5 ); }
1540        ;
1541
1542/* Provides optional identifier names (abstract_declarator/variable_declarator), no initialization, different
1543   semantics for typedef name by using typedef_parameter_redeclarator instead of typedef_redeclarator, and
1544   function prototypes. */
1545
1546new_parameter_declaration:                              /* CFA, new & old style parameter declaration */
1547        parameter_declaration
1548        | new_identifier_parameter_declarator_no_tuple identifier_or_typedef_name assignment_opt
1549                { $$ = $1->addName( $2 ); }
1550        | new_abstract_tuple identifier_or_typedef_name assignment_opt
1551                /* To obtain LR(1), these rules must be duplicated here (see new_abstract_declarator). */
1552                { $$ = $1->addName( $2 ); }
1553        | type_qualifier_list new_abstract_tuple identifier_or_typedef_name assignment_opt
1554                { $$ = $2->addName( $3 )->addQualifiers( $1 ); }
1555        | new_function_specifier
1556        ;
1557
1558new_abstract_parameter_declaration:                     /* CFA, new & old style parameter declaration */
1559        abstract_parameter_declaration
1560        | new_identifier_parameter_declarator_no_tuple
1561        | new_abstract_tuple
1562                /* To obtain LR(1), these rules must be duplicated here (see new_abstract_declarator). */
1563        | type_qualifier_list new_abstract_tuple
1564                { $$ = $2->addQualifiers( $1 ); }
1565        | new_abstract_function
1566        ;
1567
1568parameter_declaration:
1569        declaration_specifier identifier_parameter_declarator assignment_opt
1570                {
1571                    typedefTable.addToEnclosingScope( TypedefTable::ID);
1572                    $$ = $2->addType( $1 )->addInitializer( new InitializerNode($3) );
1573                }
1574        | declaration_specifier typedef_parameter_redeclarator assignment_opt
1575                {
1576                    typedefTable.addToEnclosingScope( TypedefTable::ID);
1577                    $$ = $2->addType( $1 )->addInitializer( new InitializerNode($3) );
1578                }
1579        ;
1580
1581abstract_parameter_declaration:
1582        declaration_specifier
1583        | declaration_specifier abstract_parameter_declarator
1584                { $$ = $2->addType( $1 ); }
1585        ;
1586
1587/* ISO/IEC 9899:1999 Section 6.9.1(6) : "An identifier declared as a typedef name shall not be redeclared as a
1588   parameter." Because the scope of the K&R-style parameter-list sees the typedef first, the following is
1589   based only on identifiers.  The ANSI-style parameter-list can redefine a typedef name. */
1590
1591identifier_list:                                        /* K&R-style parameter list => no types */
1592        no_attr_identifier
1593                { $$ = DeclarationNode::newName( $1 ); }
1594        | identifier_list ',' no_attr_identifier
1595                { $$ = $1->appendList( DeclarationNode::newName( $3 ) ); }
1596        ;
1597
1598identifier_or_typedef_name:
1599        identifier
1600        | TYPEDEFname
1601        | TYPEGENname
1602        ;
1603
1604no_01_identifier_or_typedef_name:
1605        no_01_identifier
1606        | TYPEDEFname
1607        | TYPEGENname
1608        ;
1609
1610no_attr_identifier_or_typedef_name:
1611        no_attr_identifier
1612        | TYPEDEFname
1613        | TYPEGENname
1614        ;
1615
1616type_name_no_function:                                  /* sizeof, alignof, cast (constructor) */
1617        new_abstract_declarator_tuple                   /* CFA */
1618        | type_specifier
1619        | type_specifier variable_abstract_declarator
1620                { $$ = $2->addType( $1 ); }
1621        ;
1622
1623type_name:                                              /* typeof, assertion */
1624        new_abstract_declarator_tuple                   /* CFA */
1625        | new_abstract_function                         /* CFA */
1626        | type_specifier
1627        | type_specifier abstract_declarator
1628                { $$ = $2->addType( $1 ); }
1629        ;
1630
1631initializer_opt:
1632        /* empty */                             { $$ = 0; }
1633        | '=' initializer                       { $$ = $2; }
1634        ;
1635
1636initializer:
1637        assignment_expression                   { $$ = new InitializerNode($1); }
1638        | '{' initializer_list comma_opt '}'    { $$ = new InitializerNode($2, true); }
1639        ;
1640
1641initializer_list:
1642        initializer
1643        | designation initializer                            { $$ = $2->set_designators( $1 ); }
1644        | initializer_list ',' initializer                   { $$ = (InitializerNode *)( $1->set_link($3) ); }
1645        | initializer_list ',' designation initializer
1646                                           { $$ = (InitializerNode *)( $1->set_link( $4->set_designators($3) ) ); }
1647        ;
1648
1649/* There is an unreconcileable parsing problem between ANSI99 and CFA with respect to designators. The problem
1650   is use of '=' to separator the designator from the initializer value, as in:
1651
1652        int x[10] = { [1] = 3 };
1653
1654   The string "[1] = 3" can be parsed as a designator assignment or a tuple assignment.  To disambiguate this
1655   case, CFA changes the syntax from "=" to ":" as the separator between the designator and initializer. GCC
1656   does uses ":" for field selection. The optional use of the "=" in GCC, or in this case ":", cannot be
1657   supported either due to shift/reduce conflicts */
1658
1659designation:
1660        designator_list ':'                             /* ANSI99, CFA uses ":" instead of "=" */
1661        | no_attr_identifier_or_typedef_name ':'                /* GCC, field name */
1662                                                       { $$ = new VarRefNode( $1 ); }
1663        ;
1664
1665designator_list:                                        /* ANSI99 */
1666        designator
1667        | designator_list designator                   { $$ = (ExpressionNode *)($1->set_link( $2 )); }
1668        ;
1669
1670designator:
1671        '.' no_attr_identifier_or_typedef_name          /* ANSI99, field name */
1672                                                       { $$ = new VarRefNode( $2 ); }
1673        | '[' push assignment_expression pop ']'        /* ANSI99, single array element */
1674                /* assignment_expression used instead of constant_expression because of shift/reduce conflicts
1675                   with tuple. */
1676                                                       { $$ = $3; }
1677        | '[' push subrange pop ']'                     /* CFA, multiple array elements */
1678                                                       { $$ = $3; }
1679        | '[' push constant_expression ELLIPSIS constant_expression pop ']' /* GCC, multiple array elements */
1680                                                       { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Range), $3, $5); }
1681        | '.' '[' push field_list pop ']'               /* CFA, tuple field selector */
1682                                                       { $$ = $4; }
1683        ;
1684
1685/* The CFA type system is based on parametric polymorphism, the ability to declare functions with type
1686   parameters, rather than an object-oriented type system. This required four groups of extensions:
1687
1688   Overloading: function, data, and operator identifiers may be overloaded.
1689
1690   Type declarations: "type" is used to generate new types for declaring objects. Similarly, "dtype" is used
1691       for object and incomplete types, and "ftype" is used for function types. Type declarations with
1692       initializers provide definitions of new types. Type declarations with storage class "extern" provide
1693       opaque types.
1694
1695   Polymorphic functions: A forall clause declares a type parameter. The corresponding argument is inferred at
1696       the call site. A polymorphic function is not a template; it is a function, with an address and a type.
1697
1698   Specifications and Assertions: Specifications are collections of declarations parameterized by one or more
1699       types. They serve many of the purposes of abstract classes, and specification hierarchies resemble
1700       subclass hierarchies. Unlike classes, they can define relationships between types.  Assertions declare
1701       that a type or types provide the operations declared by a specification.  Assertions are normally used
1702       to declare requirements on type arguments of polymorphic functions.  */
1703
1704typegen_declaration_specifier:                          /* CFA */
1705        typegen_type_specifier
1706        | declaration_qualifier_list typegen_type_specifier
1707                { $$ = $2->addQualifiers( $1 ); }
1708        | typegen_declaration_specifier storage_class   /* remaining OBSOLESCENT (see 2) */
1709                { $$ = $1->addQualifiers( $2 ); }
1710        | typegen_declaration_specifier storage_class type_qualifier_list
1711                { $$ = $1->addQualifiers( $2 )->addQualifiers( $3 ); }
1712        ;
1713
1714typegen_type_specifier:                                 /* CFA */
1715        TYPEGENname '(' type_name_list ')'
1716                { $$ = DeclarationNode::newFromTypeGen( $1, $3 ); }
1717        | type_qualifier_list TYPEGENname '(' type_name_list ')'
1718                { $$ = DeclarationNode::newFromTypeGen( $2, $4 )->addQualifiers( $1 ); }
1719        | typegen_type_specifier type_qualifier
1720                { $$ = $1->addQualifiers( $2 ); }
1721        ;
1722
1723type_parameter_list:                                    /* CFA */
1724        type_parameter assignment_opt
1725        | type_parameter_list ',' type_parameter assignment_opt
1726                { $$ = $1->appendList( $3 ); }
1727        ;
1728
1729type_parameter:                                         /* CFA */
1730        type_class no_attr_identifier_or_typedef_name
1731                { typedefTable.addToEnclosingScope(*($2), TypedefTable::TD); }
1732          assertion_list_opt
1733                { $$ = DeclarationNode::newTypeParam( $1, $2 )->addAssertions( $4 ); }
1734        | type_specifier identifier_parameter_declarator
1735        ;
1736
1737type_class:                                             /* CFA */
1738        TYPE
1739                { $$ = DeclarationNode::Type; }
1740        | DTYPE
1741                { $$ = DeclarationNode::Ftype; }
1742        | FTYPE
1743                { $$ = DeclarationNode::Dtype; }
1744        ;
1745
1746assertion_list_opt:                                     /* CFA */
1747        /* empty */
1748                { $$ = 0; }
1749        | assertion_list_opt assertion
1750                { $$ = $1 == 0 ? $2 : $1->appendList( $2 ); }
1751        ;
1752
1753assertion:                                              /* CFA */
1754        '|' no_attr_identifier_or_typedef_name '(' type_name_list ')'
1755                {
1756                    typedefTable.openContext( *($2) );
1757                    $$ = DeclarationNode::newContextUse( $2, $4 );
1758                }
1759        | '|' '{' push context_declaration_list '}'
1760                { $$ = $4; }
1761        | '|' '(' push type_parameter_list pop ')' '{' push context_declaration_list '}' '(' type_name_list ')'
1762                { $$ = 0; }
1763        ;
1764
1765type_name_list:                                         /* CFA */
1766        type_name
1767                { $$ = new TypeValueNode( $1 ); }
1768        | assignment_expression
1769        | type_name_list ',' type_name
1770                { $$ = (ExpressionNode *)($1->set_link(new TypeValueNode( $3 ))); }
1771        | type_name_list ',' assignment_expression
1772                { $$ = (ExpressionNode *)($1->set_link($3)); }
1773        ;
1774
1775type_declaring_list:                                    /* CFA */
1776        TYPE type_declarator
1777                { $$ = $2; }
1778        | storage_class_list TYPE type_declarator
1779                { $$ = $3->addQualifiers( $1 ); }
1780        | type_declaring_list ',' type_declarator
1781                { $$ = $1->appendList( $3->copyStorageClasses( $1 ) ); }
1782        ;
1783
1784type_declarator:                                        /* CFA */
1785        type_declarator_name assertion_list_opt
1786                { $$ = $1->addAssertions( $2 ); }
1787        | type_declarator_name assertion_list_opt '=' type_name
1788                { $$ = $1->addAssertions( $2 )->addType( $4 ); }
1789        ;
1790
1791type_declarator_name:                                   /* CFA */
1792        no_attr_identifier_or_typedef_name
1793                {
1794                    typedefTable.addToEnclosingScope(*($1), TypedefTable::TD);
1795                    $$ = DeclarationNode::newTypeDecl( $1, 0 );
1796                }
1797        | no_01_identifier_or_typedef_name '(' push type_parameter_list pop ')'
1798                {
1799                    typedefTable.addToEnclosingScope(*($1), TypedefTable::TG);
1800                    $$ = DeclarationNode::newTypeDecl( $1, $4 );
1801                }
1802        ;
1803
1804context_specifier:                                      /* CFA */
1805        CONTEXT no_attr_identifier_or_typedef_name '(' push type_parameter_list pop ')' '{' '}'
1806                {
1807                    typedefTable.addToEnclosingScope(*($2), TypedefTable::ID);
1808                    $$ = DeclarationNode::newContext( $2, $5, 0 );
1809                }
1810        | CONTEXT no_attr_identifier_or_typedef_name '(' push type_parameter_list pop ')' '{'
1811                {
1812                    typedefTable.enterContext( *($2) );
1813                    typedefTable.enterScope();
1814                }
1815          context_declaration_list '}'
1816                {
1817                    typedefTable.leaveContext();
1818                    typedefTable.addToEnclosingScope(*($2), TypedefTable::ID);
1819                    $$ = DeclarationNode::newContext( $2, $5, $10 );
1820                }
1821        ;
1822
1823context_declaration_list:                               /* CFA */
1824        context_declaration
1825        | context_declaration_list push context_declaration
1826                { $$ = $1->appendList( $3 ); }
1827        ;
1828
1829context_declaration:                                    /* CFA */
1830        new_context_declaring_list pop ';'
1831        | context_declaring_list pop ';'
1832        ;
1833
1834new_context_declaring_list:                             /* CFA */
1835        new_variable_specifier
1836                {
1837                    typedefTable.addToEnclosingScope2( TypedefTable::ID );
1838                    $$ = $1;
1839                }
1840        | new_function_specifier
1841                {
1842                    typedefTable.addToEnclosingScope2( TypedefTable::ID );
1843                    $$ = $1;
1844                }
1845        | new_context_declaring_list pop ',' push identifier_or_typedef_name
1846                {
1847                    typedefTable.addToEnclosingScope2( *($5), TypedefTable::ID );
1848                    $$ = $1->appendList( $1->cloneType( $5 ) );
1849                }
1850        ;
1851
1852context_declaring_list:                                 /* CFA */
1853        type_specifier declarator
1854                {
1855                    typedefTable.addToEnclosingScope2( TypedefTable::ID);
1856                    $$ = $2->addType( $1 );
1857                }
1858        | context_declaring_list pop ',' push declarator
1859                {
1860                    typedefTable.addToEnclosingScope2( TypedefTable::ID);
1861                    $$ = $1->appendList( $1->cloneBaseType( $5 ) );
1862                }
1863        ;
1864
1865/***************************** EXTERNAL DEFINITIONS *****************************/
1866
1867translation_unit:
1868        /* empty */                                     /* empty input file */
1869                {}
1870        | external_definition_list
1871                {
1872                  if( theTree ) {
1873                    theTree->appendList( $1 );
1874                  } else {
1875                    theTree = $1;
1876                  }
1877                }
1878        ;
1879
1880external_definition_list:
1881        external_definition
1882        | external_definition_list push external_definition
1883                {
1884                  if( $1 ) {
1885                    $$ = $1->appendList( $3 );
1886                  } else {
1887                    $$ = $3;
1888                  }
1889                }
1890        ;
1891
1892external_definition_list_opt:
1893        /* empty */
1894                {
1895                  $$ = 0;
1896                }
1897        | external_definition_list
1898        ;
1899
1900external_definition:
1901        declaration
1902        | function_definition
1903        | asm_statement                                 /* GCC, global assembler statement */
1904                {}
1905        | EXTERN STRINGliteral
1906                {
1907                  linkageStack.push( linkage );
1908                  linkage = LinkageSpec::fromString( *$2 );
1909                }
1910          '{' external_definition_list_opt '}'          /* C++-style linkage specifier */
1911                {
1912                  linkage = linkageStack.top();
1913                  linkageStack.pop();
1914                  $$ = $5;
1915                }
1916        | EXTENSION external_definition
1917                { $$ = $2; }
1918        ;
1919
1920function_definition:
1921        new_function_specifier compound_statement       /* CFA */
1922                {
1923                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1924                    typedefTable.leaveScope();
1925                    $$ = $1->addFunctionBody( $2 );
1926                }
1927        | declaration_qualifier_list new_function_specifier compound_statement /* CFA */
1928                /* declaration_qualifier_list also includes type_qualifier_list, so a semantic check is
1929                   necessary to preclude them as a type_qualifier cannot appear in this context. */
1930                {
1931                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1932                    typedefTable.leaveScope();
1933                    $$ = $2->addFunctionBody( $3 )->addQualifiers( $1 );
1934                }
1935
1936        | declaration_specifier function_declarator compound_statement
1937                {
1938                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1939                    typedefTable.leaveScope();
1940                    $$ = $2->addFunctionBody( $3 )->addType( $1 );
1941                }
1942
1943                /* These rules are a concession to the "implicit int" type_specifier because there is a
1944                   significant amount of code with functions missing a type-specifier on the return type.
1945                   Parsing is possible because function_definition does not appear in the context of an
1946                   expression (nested functions would preclude this concession). A function prototype
1947                   declaration must still have a type_specifier. OBSOLESCENT (see 1) */
1948        | function_declarator compound_statement
1949                {
1950                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1951                    typedefTable.leaveScope();
1952                    $$ = $1->addFunctionBody( $2 );
1953                }
1954        | type_qualifier_list function_declarator compound_statement
1955                {
1956                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1957                    typedefTable.leaveScope();
1958                    $$ = $2->addFunctionBody( $3 )->addQualifiers( $1 );
1959                }
1960        | declaration_qualifier_list function_declarator compound_statement
1961                {
1962                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1963                    typedefTable.leaveScope();
1964                    $$ = $2->addFunctionBody( $3 )->addQualifiers( $1 );
1965                }
1966        | declaration_qualifier_list type_qualifier_list function_declarator compound_statement
1967                {
1968                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1969                    typedefTable.leaveScope();
1970                    $$ = $3->addFunctionBody( $4 )->addQualifiers( $2 )->addQualifiers( $1 );
1971                }
1972
1973                /* Old-style K&R function definition, OBSOLESCENT (see 4) */
1974        | declaration_specifier old_function_declarator push old_declaration_list_opt compound_statement
1975                {
1976                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1977                    typedefTable.leaveScope();
1978                    $$ = $2->addOldDeclList( $4 )->addFunctionBody( $5 )->addType( $1 );
1979                }
1980        | old_function_declarator push old_declaration_list_opt compound_statement
1981                {
1982                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1983                    typedefTable.leaveScope();
1984                    $$ = $1->addOldDeclList( $3 )->addFunctionBody( $4 );
1985                }
1986        | type_qualifier_list old_function_declarator push old_declaration_list_opt compound_statement
1987                {
1988                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1989                    typedefTable.leaveScope();
1990                    $$ = $2->addOldDeclList( $4 )->addFunctionBody( $5 )->addQualifiers( $1 );
1991                }
1992
1993                /* Old-style K&R function definition with "implicit int" type_specifier, OBSOLESCENT (see 4) */
1994        | declaration_qualifier_list old_function_declarator push old_declaration_list_opt compound_statement
1995                {
1996                    typedefTable.addToEnclosingScope( TypedefTable::ID );
1997                    typedefTable.leaveScope();
1998                    $$ = $2->addOldDeclList( $4 )->addFunctionBody( $5 )->addQualifiers( $1 );
1999                }
2000        | declaration_qualifier_list type_qualifier_list old_function_declarator push old_declaration_list_opt
2001                        compound_statement
2002                {
2003                    typedefTable.addToEnclosingScope( TypedefTable::ID );
2004                    typedefTable.leaveScope();
2005                    $$ = $3->addOldDeclList( $5 )->addFunctionBody( $6 )->addQualifiers( $2 )->addQualifiers( $1 );
2006                }
2007        ;
2008
2009declarator:
2010        variable_declarator
2011        | function_declarator
2012        | typedef_redeclarator
2013        ;
2014
2015subrange:
2016        constant_expression '~' constant_expression     /* CFA, integer subrange */
2017                { $$ = new CompositeExprNode(new OperatorNode(OperatorNode::Range), $1, $3); }
2018        ;
2019
2020asm_name_opt:                                           /* GCC */
2021        /* empty */
2022        | ASM '(' string_literal_list ')' attribute_list_opt
2023        ;
2024
2025attribute_list_opt:                                     /* GCC */
2026        /* empty */
2027        | attribute_list
2028        ;
2029
2030attribute_list:                                         /* GCC */
2031        attribute
2032        | attribute_list attribute
2033        ;
2034
2035attribute:                                              /* GCC */
2036        ATTRIBUTE '(' '(' attribute_parameter_list ')' ')'
2037        ;
2038
2039attribute_parameter_list:                               /* GCC */
2040        attrib
2041        | attribute_parameter_list ',' attrib
2042        ;
2043
2044attrib:                                                 /* GCC */
2045        /* empty */
2046        | any_word
2047        | any_word '(' comma_expression_opt ')'
2048        ;
2049
2050any_word:                                               /* GCC */
2051        identifier_or_typedef_name {}
2052        | storage_class_name {}
2053        | basic_type_name {}
2054        | type_qualifier {}
2055        ;
2056
2057/* ============================================================================
2058   The following sections are a series of grammar patterns used to parse declarators. Multiple patterns are
2059   necessary because the type of an identifier in wrapped around the identifier in the same form as its usage
2060   in an expression, as in:
2061
2062        int (*f())[10] { ... };
2063        ... (*f())[3] += 1;     // definition mimics usage
2064
2065   Because these patterns are highly recursive, changes at a lower level in the recursion require copying some
2066   or all of the pattern. Each of these patterns has some subtle variation to ensure correct syntax in a
2067   particular context.
2068   ============================================================================ */
2069
2070/* ----------------------------------------------------------------------------
2071   The set of valid declarators before a compound statement for defining a function is less than the set of
2072   declarators to define a variable or function prototype, e.g.:
2073
2074        valid declaration       invalid definition
2075        -----------------       ------------------
2076        int f;                  int f {}
2077        int *f;                 int *f {}
2078        int f[10];              int f[10] {}
2079        int (*f)(int);          int (*f)(int) {}
2080
2081   To preclude this syntactic anomaly requires separating the grammar rules for variable and function
2082   declarators, hence variable_declarator and function_declarator.
2083   ---------------------------------------------------------------------------- */
2084
2085/* This pattern parses a declaration of a variable that is not redefining a typedef name. The pattern
2086   precludes declaring an array of functions versus a pointer to an array of functions. */
2087
2088variable_declarator:
2089        paren_identifier attribute_list_opt
2090        | variable_ptr
2091        | variable_array attribute_list_opt
2092        | variable_function attribute_list_opt
2093        ;
2094
2095paren_identifier:
2096        identifier
2097                {
2098                    typedefTable.setNextIdentifier( *($1) );
2099                    $$ = DeclarationNode::newName( $1 );
2100                }
2101        | '(' paren_identifier ')'                      /* redundant parenthesis */
2102                { $$ = $2; }
2103        ;
2104
2105variable_ptr:
2106        '*' variable_declarator
2107                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2108        | '*' type_qualifier_list variable_declarator
2109                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2110        | '(' variable_ptr ')'
2111                { $$ = $2; }
2112        ;
2113
2114variable_array:
2115        paren_identifier array_dimension
2116                { $$ = $1->addArray( $2 ); }
2117        | '(' variable_ptr ')' array_dimension
2118                { $$ = $2->addArray( $4 ); }
2119        | '(' variable_array ')' multi_array_dimension  /* redundant parenthesis */
2120                { $$ = $2->addArray( $4 ); }
2121        | '(' variable_array ')'                        /* redundant parenthesis */
2122                { $$ = $2; }
2123        ;
2124
2125variable_function:
2126        '(' variable_ptr ')' '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2127                { $$ = $2->addParamList( $6 ); }
2128        | '(' variable_function ')'                     /* redundant parenthesis */
2129                { $$ = $2; }
2130        ;
2131
2132/* This pattern parses a function declarator that is not redefining a typedef name. Because functions cannot
2133   be nested, there is no context where a function definition can redefine a typedef name. To allow nested
2134   functions requires further separation of variable and function declarators in typedef_redeclarator.  The
2135   pattern precludes returning arrays and functions versus pointers to arrays and functions. */
2136
2137function_declarator:
2138        function_no_ptr attribute_list_opt
2139        | function_ptr
2140        | function_array attribute_list_opt
2141        ;
2142
2143function_no_ptr:
2144        paren_identifier '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2145                { $$ = $1->addParamList( $4 ); }
2146        | '(' function_ptr ')' '(' push parameter_type_list_opt pop ')'
2147                { $$ = $2->addParamList( $6 ); }
2148        | '(' function_no_ptr ')'                       /* redundant parenthesis */
2149                { $$ = $2; }
2150        ;
2151
2152function_ptr:
2153        '*' function_declarator
2154                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2155        | '*' type_qualifier_list function_declarator
2156                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2157        | '(' function_ptr ')'
2158                { $$ = $2; }
2159        ;
2160
2161function_array:
2162        '(' function_ptr ')' array_dimension
2163                { $$ = $2->addArray( $4 ); }
2164        | '(' function_array ')' multi_array_dimension  /* redundant parenthesis */
2165                { $$ = $2->addArray( $4 ); }
2166        | '(' function_array ')'                        /* redundant parenthesis */
2167                { $$ = $2; }
2168        ;
2169
2170/* This pattern parses an old-style K&R function declarator (OBSOLESCENT, see 4) that is not redefining a
2171   typedef name (see function_declarator for additional comments). The pattern precludes returning arrays and
2172   functions versus pointers to arrays and functions. */
2173
2174old_function_declarator:
2175        old_function_no_ptr
2176        | old_function_ptr
2177        | old_function_array
2178        ;
2179
2180old_function_no_ptr:
2181        paren_identifier '(' identifier_list ')'        /* function_declarator handles empty parameter */
2182                { $$ = $1->addIdList( $3 ); }
2183        | '(' old_function_ptr ')' '(' identifier_list ')'
2184                { $$ = $2->addIdList( $5 ); }
2185        | '(' old_function_no_ptr ')'                   /* redundant parenthesis */
2186                { $$ = $2; }
2187        ;
2188
2189old_function_ptr:
2190        '*' old_function_declarator
2191                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2192        | '*' type_qualifier_list old_function_declarator
2193                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2194        | '(' old_function_ptr ')'
2195                { $$ = $2; }
2196        ;
2197
2198old_function_array:
2199        '(' old_function_ptr ')' array_dimension
2200                { $$ = $2->addArray( $4 ); }
2201        | '(' old_function_array ')' multi_array_dimension /* redundant parenthesis */
2202                { $$ = $2->addArray( $4 ); }
2203        | '(' old_function_array ')'                    /* redundant parenthesis */
2204                { $$ = $2; }
2205        ;
2206
2207/* This pattern parses a declaration for a variable or function prototype that redefines a typedef name, e.g.:
2208
2209        typedef int foo;
2210        {
2211           int foo; // redefine typedef name in new scope
2212        }
2213
2214   The pattern precludes declaring an array of functions versus a pointer to an array of functions, and
2215   returning arrays and functions versus pointers to arrays and functions. */
2216
2217typedef_redeclarator:
2218        paren_typedef attribute_list_opt
2219        | typedef_ptr
2220        | typedef_array attribute_list_opt
2221        | typedef_function attribute_list_opt
2222        ;
2223
2224paren_typedef:
2225        TYPEDEFname
2226                {
2227                typedefTable.setNextIdentifier( *($1) );
2228                $$ = DeclarationNode::newName( $1 );
2229                }
2230        | '(' paren_typedef ')'
2231                { $$ = $2; }
2232        ;
2233
2234typedef_ptr:
2235        '*' typedef_redeclarator
2236                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2237        | '*' type_qualifier_list typedef_redeclarator
2238                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2239        | '(' typedef_ptr ')'
2240                { $$ = $2; }
2241        ;
2242
2243typedef_array:
2244        paren_typedef array_dimension
2245                { $$ = $1->addArray( $2 ); }
2246        | '(' typedef_ptr ')' array_dimension
2247                { $$ = $2->addArray( $4 ); }
2248        | '(' typedef_array ')' multi_array_dimension   /* redundant parenthesis */
2249                { $$ = $2->addArray( $4 ); }
2250        | '(' typedef_array ')'                         /* redundant parenthesis */
2251                { $$ = $2; }
2252        ;
2253
2254typedef_function:
2255        paren_typedef '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2256                { $$ = $1->addParamList( $4 ); }
2257        | '(' typedef_ptr ')' '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2258                { $$ = $2->addParamList( $6 ); }
2259        | '(' typedef_function ')'                      /* redundant parenthesis */
2260                { $$ = $2; }
2261        ;
2262
2263/* This pattern parses a declaration for a parameter variable or function prototype that is not redefining a
2264   typedef name and allows the ANSI99 array options, which can only appear in a parameter list.  The pattern
2265   precludes declaring an array of functions versus a pointer to an array of functions, and returning arrays
2266   and functions versus pointers to arrays and functions. */
2267
2268identifier_parameter_declarator:
2269        paren_identifier attribute_list_opt
2270        | identifier_parameter_ptr
2271        | identifier_parameter_array attribute_list_opt
2272        | identifier_parameter_function attribute_list_opt
2273        ;
2274
2275identifier_parameter_ptr:
2276        '*' identifier_parameter_declarator
2277                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2278        | '*' type_qualifier_list identifier_parameter_declarator
2279                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2280        | '(' identifier_parameter_ptr ')'
2281                { $$ = $2; }
2282        ;
2283
2284identifier_parameter_array:
2285        paren_identifier array_parameter_dimension
2286                { $$ = $1->addArray( $2 ); }
2287        | '(' identifier_parameter_ptr ')' array_dimension
2288                { $$ = $2->addArray( $4 ); }
2289        | '(' identifier_parameter_array ')' multi_array_dimension /* redundant parenthesis */
2290                { $$ = $2->addArray( $4 ); }
2291        | '(' identifier_parameter_array ')'            /* redundant parenthesis */
2292                { $$ = $2; }
2293        ;
2294
2295identifier_parameter_function:
2296        paren_identifier '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2297                { $$ = $1->addParamList( $4 ); }
2298        | '(' identifier_parameter_ptr ')' '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2299                { $$ = $2->addParamList( $6 ); }
2300        | '(' identifier_parameter_function ')'         /* redundant parenthesis */
2301                { $$ = $2; }
2302        ;
2303
2304/* This pattern parses a declaration for a parameter variable or function prototype that is redefining a
2305   typedef name, e.g.:
2306
2307        typedef int foo;
2308        int f( int foo ); // redefine typedef name in new scope
2309
2310   and allows the ANSI99 array options, which can only appear in a parameter list.  In addition, the pattern
2311   handles the special meaning of parenthesis around a typedef name:
2312
2313        ISO/IEC 9899:1999 Section 6.7.5.3(11) : "In a parameter declaration, a single typedef name in
2314        parentheses is taken to be an abstract declarator that specifies a function with a single parameter,
2315        not as redundant parentheses around the identifier."
2316
2317   which precludes the following cases:
2318
2319        typedef float T;
2320        int f( int ( T [5] ) );                 // see abstract_parameter_declarator
2321        int g( int ( T ( int ) ) );             // see abstract_parameter_declarator
2322        int f( int f1( T a[5] ) );              // see identifier_parameter_declarator
2323        int g( int g1( T g2( int p ) ) );       // see identifier_parameter_declarator
2324
2325   In essence, a '(' immediately to the left of typedef name, T, is interpreted as starting a parameter type
2326   list, and not as redundant parentheses around a redeclaration of T. Finally, the pattern also precludes
2327   declaring an array of functions versus a pointer to an array of functions, and returning arrays and
2328   functions versus pointers to arrays and functions. */
2329
2330typedef_parameter_redeclarator:
2331        typedef attribute_list_opt
2332        | typedef_parameter_ptr
2333        | typedef_parameter_array attribute_list_opt
2334        | typedef_parameter_function attribute_list_opt
2335        ;
2336
2337typedef:
2338        TYPEDEFname
2339                {
2340                    typedefTable.setNextIdentifier( *($1) );
2341                    $$ = DeclarationNode::newName( $1 );
2342                }
2343        ;
2344
2345typedef_parameter_ptr:
2346        '*' typedef_parameter_redeclarator
2347                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2348        | '*' type_qualifier_list typedef_parameter_redeclarator
2349                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2350        | '(' typedef_parameter_ptr ')'
2351                { $$ = $2; }
2352        ;
2353
2354typedef_parameter_array:
2355        typedef array_parameter_dimension
2356                { $$ = $1->addArray( $2 ); }
2357        | '(' typedef_parameter_ptr ')' array_parameter_dimension
2358                { $$ = $2->addArray( $4 ); }
2359        ;
2360
2361typedef_parameter_function:
2362        typedef '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2363                { $$ = $1->addParamList( $4 ); }
2364        | '(' typedef_parameter_ptr ')' '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2365                { $$ = $2->addParamList( $6 ); }
2366        ;
2367
2368/* This pattern parses a declaration of an abstract variable or function prototype, i.e., there is no
2369   identifier to which the type applies, e.g.:
2370
2371        sizeof( int );
2372        sizeof( int [10] );
2373
2374   The pattern precludes declaring an array of functions versus a pointer to an array of functions, and
2375   returning arrays and functions versus pointers to arrays and functions. */
2376
2377abstract_declarator:
2378        abstract_ptr
2379        | abstract_array attribute_list_opt
2380        | abstract_function attribute_list_opt
2381        ;
2382
2383abstract_ptr:
2384        '*'
2385                { $$ = DeclarationNode::newPointer( 0 ); }
2386        | '*' type_qualifier_list
2387                { $$ = DeclarationNode::newPointer( $2 ); }
2388        | '*' abstract_declarator
2389                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2390        | '*' type_qualifier_list abstract_declarator
2391                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2392        | '(' abstract_ptr ')'
2393                { $$ = $2; }
2394        ;
2395
2396abstract_array:
2397        array_dimension
2398        | '(' abstract_ptr ')' array_dimension
2399                { $$ = $2->addArray( $4 ); }
2400        | '(' abstract_array ')' multi_array_dimension  /* redundant parenthesis */
2401                { $$ = $2->addArray( $4 ); }
2402        | '(' abstract_array ')'                        /* redundant parenthesis */
2403                { $$ = $2; }
2404        ;
2405
2406abstract_function:
2407        '(' push parameter_type_list_opt pop ')'        /* empty parameter list OBSOLESCENT (see 3) */
2408                { $$ = DeclarationNode::newFunction( 0, 0, $3, 0 ); }
2409        | '(' abstract_ptr ')' '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2410                { $$ = $2->addParamList( $6 ); }
2411        | '(' abstract_function ')'                     /* redundant parenthesis */
2412                { $$ = $2; }
2413        ;
2414
2415array_dimension:
2416                /* Only the first dimension can be empty. */
2417        '[' push pop ']'
2418                { $$ = DeclarationNode::newArray( 0, 0, false ); }
2419        | '[' push pop ']' multi_array_dimension
2420                { $$ = DeclarationNode::newArray( 0, 0, false )->addArray( $5 ); }
2421        | multi_array_dimension
2422        ;
2423
2424multi_array_dimension:
2425        '[' push assignment_expression pop ']'
2426                { $$ = DeclarationNode::newArray( $3, 0, false ); }
2427        | '[' push '*' pop ']'                          /* ANSI99 */
2428                { $$ = DeclarationNode::newVarArray( 0 ); }
2429        | multi_array_dimension '[' push assignment_expression pop ']'
2430                { $$ = $1->addArray( DeclarationNode::newArray( $4, 0, false ) ); }
2431        | multi_array_dimension '[' push '*' pop ']'    /* ANSI99 */
2432                { $$ = $1->addArray( DeclarationNode::newVarArray( 0 ) ); }
2433        ;
2434
2435/* This pattern parses a declaration of a parameter abstract variable or function prototype, i.e., there is no
2436   identifier to which the type applies, e.g.:
2437
2438        int f( int );           // abstract variable parameter; no parameter name specified
2439        int f( int (int) );     // abstract function-prototype parameter; no parameter name specified
2440
2441   The pattern precludes declaring an array of functions versus a pointer to an array of functions, and
2442   returning arrays and functions versus pointers to arrays and functions. */
2443
2444abstract_parameter_declarator:
2445        abstract_parameter_ptr
2446        | abstract_parameter_array attribute_list_opt
2447        | abstract_parameter_function attribute_list_opt
2448        ;
2449
2450abstract_parameter_ptr:
2451        '*'
2452                { $$ = DeclarationNode::newPointer( 0 ); }
2453        | '*' type_qualifier_list
2454                { $$ = DeclarationNode::newPointer( $2 ); }
2455        | '*' abstract_parameter_declarator
2456                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2457        | '*' type_qualifier_list abstract_parameter_declarator
2458                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2459        | '(' abstract_parameter_ptr ')'
2460                { $$ = $2; }
2461        ;
2462
2463abstract_parameter_array:
2464        array_parameter_dimension
2465        | '(' abstract_parameter_ptr ')' array_parameter_dimension
2466                { $$ = $2->addArray( $4 ); }
2467        | '(' abstract_parameter_array ')' multi_array_dimension /* redundant parenthesis */
2468                { $$ = $2->addArray( $4 ); }
2469        | '(' abstract_parameter_array ')'              /* redundant parenthesis */
2470                { $$ = $2; }
2471        ;
2472
2473abstract_parameter_function:
2474        '(' push parameter_type_list_opt pop ')'        /* empty parameter list OBSOLESCENT (see 3) */
2475                { $$ = DeclarationNode::newFunction( 0, 0, $3, 0 ); }
2476        | '(' abstract_parameter_ptr ')' '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2477                { $$ = $2->addParamList( $6 ); }
2478        | '(' abstract_parameter_function ')'           /* redundant parenthesis */
2479                { $$ = $2; }
2480        ;
2481
2482array_parameter_dimension:
2483                /* Only the first dimension can be empty or have qualifiers. */
2484        array_parameter_1st_dimension
2485        | array_parameter_1st_dimension multi_array_dimension
2486                { $$ = $1->addArray( $2 ); }
2487        | multi_array_dimension
2488        ;
2489
2490/* The declaration of an array parameter has additional syntax over arrays in normal variable declarations:
2491
2492        ISO/IEC 9899:1999 Section 6.7.5.2(1) : "The optional type qualifiers and the keyword static shall
2493        appear only in a declaration of a function parameter with an array type, and then only in the
2494        outermost array type derivation."
2495   */
2496
2497array_parameter_1st_dimension:
2498        '[' push pop ']'
2499                { $$ = DeclarationNode::newArray( 0, 0, false ); }
2500        | '[' push type_qualifier_list '*' pop ']'      /* remaining ANSI99 */
2501                { $$ = DeclarationNode::newVarArray( $3 ); }
2502        | '[' push type_qualifier_list assignment_expression pop ']'
2503                { $$ = DeclarationNode::newArray( $4, $3, false ); }
2504        | '[' push STATIC assignment_expression pop ']'
2505                { $$ = DeclarationNode::newArray( $4, 0, true ); }
2506        | '[' push STATIC type_qualifier_list assignment_expression pop ']'
2507                { $$ = DeclarationNode::newArray( $5, $4, true ); }
2508        ;
2509
2510/* This pattern parses a declaration of an abstract variable, i.e., there is no identifier to which the type
2511   applies, e.g.:
2512
2513        sizeof( int ); // abstract variable; no identifier name specified
2514
2515   The pattern precludes declaring an array of functions versus a pointer to an array of functions, and
2516   returning arrays and functions versus pointers to arrays and functions. */
2517
2518variable_abstract_declarator:
2519        variable_abstract_ptr
2520        | variable_abstract_array attribute_list_opt
2521        | variable_abstract_function attribute_list_opt
2522        ;
2523
2524variable_abstract_ptr:
2525        '*'
2526                { $$ = DeclarationNode::newPointer( 0 ); }
2527        | '*' type_qualifier_list
2528                { $$ = DeclarationNode::newPointer( $2 ); }
2529        | '*' variable_abstract_declarator
2530                { $$ = $2->addPointer( DeclarationNode::newPointer( 0 ) ); }
2531        | '*' type_qualifier_list variable_abstract_declarator
2532                { $$ = $3->addPointer( DeclarationNode::newPointer( $2 ) ); }
2533        | '(' variable_abstract_ptr ')'
2534                { $$ = $2; }
2535        ;
2536
2537variable_abstract_array:
2538        array_dimension
2539        | '(' variable_abstract_ptr ')' array_dimension
2540                { $$ = $2->addArray( $4 ); }
2541        | '(' variable_abstract_array ')' multi_array_dimension /* redundant parenthesis */
2542                { $$ = $2->addArray( $4 ); }
2543        | '(' variable_abstract_array ')'               /* redundant parenthesis */
2544                { $$ = $2; }
2545        ;
2546
2547variable_abstract_function:
2548        '(' variable_abstract_ptr ')' '(' push parameter_type_list_opt pop ')' /* empty parameter list OBSOLESCENT (see 3) */
2549                { $$ = $2->addParamList( $6 ); }
2550        | '(' variable_abstract_function ')'            /* redundant parenthesis */
2551                { $$ = $2; }
2552        ;
2553
2554/* This pattern parses a new-style declaration for a parameter variable or function prototype that is either
2555   an identifier or typedef name and allows the ANSI99 array options, which can only appear in a parameter
2556   list. */
2557
2558new_identifier_parameter_declarator_tuple:              /* CFA */
2559        new_identifier_parameter_declarator_no_tuple
2560        | new_abstract_tuple
2561        | type_qualifier_list new_abstract_tuple
2562                { $$ = $2->addQualifiers( $1 ); }
2563        ;
2564
2565new_identifier_parameter_declarator_no_tuple:           /* CFA */
2566        new_identifier_parameter_ptr
2567        | new_identifier_parameter_array
2568        ;
2569
2570new_identifier_parameter_ptr:                           /* CFA */
2571        '*' type_specifier
2572                { $$ = $2->addNewPointer( DeclarationNode::newPointer( 0 ) ); }
2573        | type_qualifier_list '*' type_specifier
2574                { $$ = $3->addNewPointer( DeclarationNode::newPointer( $1 ) ); }
2575        | '*' new_abstract_function
2576                { $$ = $2->addNewPointer( DeclarationNode::newPointer( 0 ) ); }
2577        | type_qualifier_list '*' new_abstract_function
2578                { $$ = $3->addNewPointer( DeclarationNode::newPointer( $1 ) ); }
2579        | '*' new_identifier_parameter_declarator_tuple
2580                { $$ = $2->addNewPointer( DeclarationNode::newPointer( 0 ) ); }
2581        | type_qualifier_list '*' new_identifier_parameter_declarator_tuple
2582                { $$ = $3->addNewPointer( DeclarationNode::newPointer( $1 ) ); }
2583        ;
2584
2585new_identifier_parameter_array:                         /* CFA */
2586                /* Only the first dimension can be empty or have qualifiers. Empty dimension must be factored
2587                   out due to shift/reduce conflict with new-style empty (void) function return type. */
2588        '[' push pop ']' type_specifier
2589                { $$ = $5->addNewArray( DeclarationNode::newArray( 0, 0, false ) ); }
2590        | new_array_parameter_1st_dimension type_specifier
2591                { $$ = $2->addNewArray( $1 ); }
2592        | '[' push pop ']' multi_array_dimension type_specifier
2593                { $$ = $6->addNewArray( $5 )->addNewArray( DeclarationNode::newArray( 0, 0, false ) ); }
2594        | new_array_parameter_1st_dimension multi_array_dimension type_specifier
2595                { $$ = $3->addNewArray( $2 )->addNewArray( $1 ); }
2596        | multi_array_dimension type_specifier
2597                { $$ = $2->addNewArray( $1 ); }
2598        | '[' push pop ']' new_identifier_parameter_ptr
2599                { $$ = $5->addNewArray( DeclarationNode::newArray( 0, 0, false ) ); }
2600        | new_array_parameter_1st_dimension new_identifier_parameter_ptr
2601                { $$ = $2->addNewArray( $1 ); }
2602        | '[' push pop ']' multi_array_dimension new_identifier_parameter_ptr
2603                { $$ = $6->addNewArray( $5 )->addNewArray( DeclarationNode::newArray( 0, 0, false ) ); }
2604        | new_array_parameter_1st_dimension multi_array_dimension new_identifier_parameter_ptr
2605                { $$ = $3->addNewArray( $2 )->addNewArray( $1 ); }
2606        | multi_array_dimension new_identifier_parameter_ptr
2607                { $$ = $2->addNewArray( $1 ); }
2608        ;
2609
2610new_array_parameter_1st_dimension:
2611        '[' push type_qualifier_list '*' pop ']'        /* remaining ANSI99 */
2612                { $$ = DeclarationNode::newVarArray( $3 ); }
2613        | '[' push type_qualifier_list assignment_expression pop ']'
2614                { $$ = DeclarationNode::newArray( $4, $3, false ); }
2615        | '[' push declaration_qualifier_list assignment_expression pop ']'
2616                /* declaration_qualifier_list must be used because of shift/reduce conflict with
2617                   assignment_expression, so a semantic check is necessary to preclude them as a
2618                   type_qualifier cannot appear in this context. */
2619                { $$ = DeclarationNode::newArray( $4, $3, true ); }
2620        | '[' push declaration_qualifier_list type_qualifier_list assignment_expression pop ']'
2621                { $$ = DeclarationNode::newArray( $5, $4->addQualifiers( $3 ), true ); }
2622        ;
2623
2624/* This pattern parses a new-style declaration of an abstract variable or function prototype, i.e., there is
2625   no identifier to which the type applies, e.g.:
2626
2627        [int] f( int );         // abstract variable parameter; no parameter name specified
2628        [int] f( [int] (int) ); // abstract function-prototype parameter; no parameter name specified
2629
2630   These rules need LR(3):
2631
2632        new_abstract_tuple identifier_or_typedef_name
2633        '[' new_parameter_list ']' identifier_or_typedef_name '(' new_parameter_type_list_opt ')'
2634
2635   since a function return type can be syntactically identical to a tuple type:
2636
2637        [int, int] t;
2638        [int, int] f( int );
2639
2640   Therefore, it is necessary to look at the token after identifier_or_typedef_name to know when to reduce
2641   new_abstract_tuple. To make this LR(1), several rules have to be flattened (lengthened) to allow
2642   the necessary lookahead. To accomplish this, new_abstract_declarator has an entry point without tuple, and
2643   tuple declarations are duplicated when appearing with new_function_specifier. */
2644
2645new_abstract_declarator_tuple:                          /* CFA */
2646        new_abstract_tuple
2647        | type_qualifier_list new_abstract_tuple
2648                { $$ = $2->addQualifiers( $1 ); }
2649        | new_abstract_declarator_no_tuple
2650        ;
2651
2652new_abstract_declarator_no_tuple:                       /* CFA */
2653        new_abstract_ptr
2654        | new_abstract_array
2655        ;
2656
2657new_abstract_ptr:                                       /* CFA */
2658        '*' type_specifier
2659                { $$ = $2->addNewPointer( DeclarationNode::newPointer( 0 ) ); }
2660        | type_qualifier_list '*' type_specifier
2661                { $$ = $3->addNewPointer( DeclarationNode::newPointer( $1 ) ); }
2662        | '*' new_abstract_function
2663                { $$ = $2->addNewPointer( DeclarationNode::newPointer( 0 ) ); }
2664        | type_qualifier_list '*' new_abstract_function
2665                { $$ = $3->addNewPointer( DeclarationNode::newPointer( $1 ) ); }
2666        | '*' new_abstract_declarator_tuple
2667                { $$ = $2->addNewPointer( DeclarationNode::newPointer( 0 ) ); }
2668        | type_qualifier_list '*' new_abstract_declarator_tuple
2669                { $$ = $3->addNewPointer( DeclarationNode::newPointer( $1 ) ); }
2670        ;
2671
2672new_abstract_array:                                     /* CFA */
2673                /* Only the first dimension can be empty. Empty dimension must be factored out due to
2674                   shift/reduce conflict with empty (void) function return type. */
2675        '[' push pop ']' type_specifier
2676                { $$ = $5->addNewArray( DeclarationNode::newArray( 0, 0, false ) ); }
2677        | '[' push pop ']' multi_array_dimension type_specifier
2678                { $$ = $6->addNewArray( $5 )->addNewArray( DeclarationNode::newArray( 0, 0, false ) ); }
2679        | multi_array_dimension type_specifier
2680                { $$ = $2->addNewArray( $1 ); }
2681        | '[' push pop ']' new_abstract_ptr
2682                { $$ = $5->addNewArray( DeclarationNode::newArray( 0, 0, false ) ); }
2683        | '[' push pop ']' multi_array_dimension new_abstract_ptr
2684                { $$ = $6->addNewArray( $5 )->addNewArray( DeclarationNode::newArray( 0, 0, false ) ); }
2685        | multi_array_dimension new_abstract_ptr
2686                { $$ = $2->addNewArray( $1 ); }
2687        ;
2688
2689new_abstract_tuple:                                     /* CFA */
2690        '[' push new_abstract_parameter_list pop ']'
2691                { $$ = DeclarationNode::newTuple( $3 ); }
2692        ;
2693
2694new_abstract_function:                                  /* CFA */
2695        '[' push pop ']' '(' new_parameter_type_list_opt ')'
2696                { $$ = DeclarationNode::newFunction( 0, DeclarationNode::newTuple( 0 ), $6, 0 ); }
2697        | new_abstract_tuple '(' push new_parameter_type_list_opt pop ')'
2698                { $$ = DeclarationNode::newFunction( 0, $1, $4, 0 ); }
2699        | new_function_return '(' push new_parameter_type_list_opt pop ')'
2700                { $$ = DeclarationNode::newFunction( 0, $1, $4, 0 ); }
2701        ;
2702
2703/* 1) ISO/IEC 9899:1999 Section 6.7.2(2) : "At least one type specifier shall be given in the declaration
2704      specifiers in each declaration, and in the specifier-qualifier list in each structure declaration and
2705      type name."
2706
2707   2) ISO/IEC 9899:1999 Section 6.11.5(1) : "The placement of a storage-class specifier other than at the
2708      beginning of the declaration specifiers in a declaration is an obsolescent feature."
2709
2710   3) ISO/IEC 9899:1999 Section 6.11.6(1) : "The use of function declarators with empty parentheses (not
2711      prototype-format parameter type declarators) is an obsolescent feature."
2712
2713   4) ISO/IEC 9899:1999 Section 6.11.7(1) : "The use of function definitions with separate parameter
2714      identifier and declaration lists (not prototype-format parameter type and identifier declarators) is
2715      an obsolescent feature."  */
2716
2717/************************* MISCELLANEOUS ********************************/
2718
2719comma_opt:                                              /* redundant comma */
2720        /* empty */
2721        | ','
2722        ;
2723
2724assignment_opt:
2725        /* empty */
2726                { $$ = 0; }
2727        | '=' assignment_expression
2728                { $$ = $2; }
2729        ;
2730
2731%%
2732/* ----end of grammar----*/
2733
2734void yyerror(char *string) {
2735    using std::cout;
2736    using std::endl;
2737    if( yyfilename ) {
2738      cout << yyfilename << ":" << endl;
2739    }
2740    cout << yylineno << ": syntax error reading token " << *(yylval.tok.str) << endl;
2741}
2742
2743/* Local Variables: */
2744/* fill-column: 110 */
2745/* compile-command: "gmake" */
2746/* End: */
Note: See TracBrowser for help on using the repository browser.