source: translator/Parser/cfa.y @ bdd516a

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 bdd516a was bdd516a, checked in by Peter A. Buhr <pabuhr@…>, 9 years ago

fixed sizeof type variable, find lowest cost alternative for sizeof expression, removed unused classes, added compiler flag, remove temporary file for -CFA, formatting

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