source: translator/Parser/cfa.y @ 0b8cd722

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 0b8cd722 was 17cd4eb, checked in by Peter A. Buhr <pabuhr@…>, 10 years ago

fixed restrict, fixed parameter copy, introduced name table for types, changed variable after to string

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