cparser/Parser.mly

   1 /*(*
   2  *
   3  * Copyright (c) 2001-2003,
   4  *  George C. Necula    <necula@cs.berkeley.edu>
   5  *  Scott McPeak        <smcpeak@cs.berkeley.edu>
   6  *  Wes Weimer          <weimer@cs.berkeley.edu>
   7  *  Ben Liblit          <liblit@cs.berkeley.edu>
   8  * All rights reserved.
   9  *
  10  * Redistribution and use in source and binary forms, with or without
  11  * modification, are permitted provided that the following conditions are
  12  * met:
  13  *
  14  * 1. Redistributions of source code must retain the above copyright
  15  * notice, this list of conditions and the following disclaimer.
  16  *
  17  * 2. Redistributions in binary form must reproduce the above copyright
  18  * notice, this list of conditions and the following disclaimer in the
  19  * documentation and/or other materials provided with the distribution.
  20  *
  21  * 3. The names of the contributors may not be used to endorse or promote
  22  * products derived from this software without specific prior written
  23  * permission.
  24  *
  25  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
  26  * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  27  * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
  28  * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
  29  * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  30  * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  31  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  32  * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  33  * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  34  * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  35  * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  36  *
  37  **)
  38 (**
  39 ** 1.0  3.22.99 Hugues Cassé    First version.
  40 ** 2.0  George Necula 12/12/00: Practically complete rewrite.
  41 *)
  42 */
  43 %{
  44 open Cabs
  45 open Cabshelper
  46 open Parse_aux
  47
  48 (*
  49 ** Expression building
  50 *)
  51 let smooth_expression lst =
  52   match lst with
  53     [] -> NOTHING
  54   | [expr] -> expr
  55   | _ -> COMMA (lst)
  56
  57
  58 let currentFunctionName = ref "<outside any function>"
  59
  60 let announceFunctionName ((n, decl, _, _):name) =
  61   !add_identifier n;
  62   (* Start a context that includes the parameter names and the whole body.
  63    * Will pop when we finish parsing the function body *)
  64   !push_context ();
  65   (* Go through all the parameter names and mark them as identifiers *)
  66   let rec findProto = function
  67       PROTO (d, args, _) when isJUSTBASE d ->
  68         List.iter (fun (_, (an, _, _, _)) -> !add_identifier an) args
  69
  70     | PROTO (d, _, _) -> findProto d
  71     | PARENTYPE (_, d, _) -> findProto d
  72     | PTR (_, d) -> findProto d
  73     | ARRAY (d, _, _) -> findProto d
  74     | _ -> parse_error "Cannot find the prototype in a function definition";
  75            raise Parsing.Parse_error
  76
  77   and isJUSTBASE = function
  78       JUSTBASE -> true
  79     | PARENTYPE (_, d, _) -> isJUSTBASE d
  80     | _ -> false
  81   in
  82   findProto decl;
  83   currentFunctionName := n
  84
  85
  86
  87 let applyPointer (ptspecs: attribute list list) (dt: decl_type)
  88        : decl_type =
  89   (* Outer specification first *)
  90   let rec loop = function
  91       [] -> dt
  92     | attrs :: rest -> PTR(attrs, loop rest)
  93   in
  94   loop ptspecs
  95
  96 let doDeclaration (loc: cabsloc) (specs: spec_elem list) (nl: init_name list) : definition =
  97   if isTypedef specs then begin
  98     (* Tell the lexer about the new type names *)
  99     List.iter (fun ((n, _, _, _), _) -> !add_type n) nl;
 100     TYPEDEF ((specs, List.map (fun (n, _) -> n) nl), loc)
 101   end else
 102     if nl = [] then
 103       ONLYTYPEDEF (specs, loc)
 104     else begin
 105       (* Tell the lexer about the new variable names *)
 106       List.iter (fun ((n, _, _, _), _) -> !add_identifier n) nl;
 107       DECDEF ((specs, nl), loc)
 108     end
 109
 110
 111 let doFunctionDef (loc: cabsloc)
 112                   (lend: cabsloc)
 113                   (specs: spec_elem list)
 114                   (n: name)
 115                   (b: block) : definition =
 116   let fname = (specs, n) in
 117   FUNDEF (fname, b, loc, lend)
 118
 119
 120 let doOldParDecl (names: string list)
 121                  ((pardefs: name_group list), (isva: bool))
 122     : single_name list * bool =
 123   let findOneName n =
 124     (* Search in pardefs for the definition for this parameter *)
 125     let rec loopGroups = function
 126         [] -> ([SpecType Tint], (n, JUSTBASE, [], cabslu))
 127       | (specs, names) :: restgroups ->
 128           let rec loopNames = function
 129               [] -> loopGroups restgroups
 130             | ((n',_, _, _) as sn) :: _ when n' = n -> (specs, sn)
 131             | _ :: restnames -> loopNames restnames
 132           in
 133           loopNames names
 134     in
 135     loopGroups pardefs
 136   in
 137   let args = List.map findOneName names in
 138   (args, isva)
 139
 140 let int64_to_char value =
 141   if (compare value (Int64.of_int 255) > 0) || (compare value Int64.zero < 0) then
 142     begin
 143       let msg = Printf.sprintf "cparser:intlist_to_string: character 0x%Lx too big" value in
 144       parse_error msg;
 145       raise Parsing.Parse_error
 146     end
 147   else
 148     Char.chr (Int64.to_int value)
 149
 150 (* takes a not-nul-terminated list, and converts it to a string. *)
 151 let rec intlist_to_string (str: int64 list):string =
 152   match str with
 153     [] -> ""  (* add nul-termination *)
 154   | value::rest ->
 155       let this_char = int64_to_char value in
 156       (String.make 1 this_char) ^ (intlist_to_string rest)
 157
 158 let fst3 (result, _, _) = result
 159 let snd3 (_, result, _) = result
 160 let trd3 (_, _, result) = result
 161
 162
 163 (*
 164    transform:  __builtin_offsetof(type, member)
 165    into     :  (size_t) (&(type * ) 0)->member
 166  *)
 167
 168 let transformOffsetOf (speclist, dtype) member =
 169   let rec addPointer = function
 170     | JUSTBASE ->
 171         PTR([], JUSTBASE)
 172     | PARENTYPE (attrs1, dtype, attrs2) ->
 173         PARENTYPE (attrs1, addPointer dtype, attrs2)
 174     | ARRAY (dtype, attrs, expr) ->
 175         ARRAY (addPointer dtype, attrs, expr)
 176     | PTR (attrs, dtype) ->
 177         PTR (attrs, addPointer dtype)
 178     | PROTO (dtype, names, variadic) ->
 179         PROTO (addPointer dtype, names, variadic)
 180   in
 181   let nullType = (speclist, addPointer dtype) in
 182   let nullExpr = CONSTANT (CONST_INT "0") in
 183   let castExpr = CAST (nullType, SINGLE_INIT nullExpr) in
 184
 185   let rec replaceBase = function
 186     | VARIABLE field ->
 187         MEMBEROFPTR (castExpr, field)
 188     | MEMBEROF (base, field) ->
 189         MEMBEROF (replaceBase base, field)
 190     | INDEX (base, index) ->
 191         INDEX (replaceBase base, index)
 192     | _ ->
 193         parse_error "malformed offset expression in __builtin_offsetof";
 194         raise Parsing.Parse_error
 195   in
 196   let memberExpr = replaceBase member in
 197   let addrExpr = UNARY (ADDROF, memberExpr) in
 198   (* slight cheat: hard-coded assumption that size_t == unsigned int *)
 199   let sizeofType = [SpecType Tunsigned], JUSTBASE in
 200   let resultExpr = CAST (sizeofType, SINGLE_INIT addrExpr) in
 201   resultExpr
 202
 203 %}
 204
 205 %token <string * Cabs.cabsloc> IDENT
 206 %token <int64 list * Cabs.cabsloc> CST_CHAR
 207 %token <int64 list * Cabs.cabsloc> CST_WCHAR
 208 %token <string * Cabs.cabsloc> CST_INT
 209 %token <string * Cabs.cabsloc> CST_FLOAT
 210 %token <string * Cabs.cabsloc> NAMED_TYPE
 211
 212 /* Each character is its own list element, and the terminating nul is not
 213    included in this list. */
 214 %token <int64 list * Cabs.cabsloc> CST_STRING
 215 %token <int64 list * Cabs.cabsloc> CST_WSTRING
 216
 217 %token EOF
 218 %token<Cabs.cabsloc> CHAR INT DOUBLE FLOAT VOID INT64 INT32 UNDERSCORE_BOOL
 219 %token<Cabs.cabsloc> ENUM STRUCT TYPEDEF UNION
 220 %token<Cabs.cabsloc> SIGNED UNSIGNED LONG SHORT
 221 %token<Cabs.cabsloc> VOLATILE EXTERN STATIC CONST RESTRICT AUTO REGISTER
 222 %token<Cabs.cabsloc> THREAD
 223
 224 %token<Cabs.cabsloc> SIZEOF ALIGNOF
 225
 226 %token EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
 227 %token AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
 228 %token ARROW DOT
 229
 230 %token EQ_EQ EXCLAM_EQ INF SUP INF_EQ SUP_EQ
 231 %token<Cabs.cabsloc> PLUS MINUS STAR
 232 %token SLASH PERCENT
 233 %token<Cabs.cabsloc> TILDE AND
 234 %token PIPE CIRC
 235 %token<Cabs.cabsloc> EXCLAM AND_AND
 236 %token PIPE_PIPE
 237 %token INF_INF SUP_SUP
 238 %token<Cabs.cabsloc> PLUS_PLUS MINUS_MINUS
 239
 240 %token RPAREN
 241 %token<Cabs.cabsloc> LPAREN RBRACE
 242 %token<Cabs.cabsloc> LBRACE
 243 %token LBRACKET RBRACKET
 244 %token COLON
 245 %token<Cabs.cabsloc> SEMICOLON
 246 %token COMMA ELLIPSIS QUEST
 247
 248 %token<Cabs.cabsloc> BREAK CONTINUE GOTO RETURN
 249 %token<Cabs.cabsloc> SWITCH CASE DEFAULT
 250 %token<Cabs.cabsloc> WHILE DO FOR
 251 %token<Cabs.cabsloc> IF TRY EXCEPT FINALLY
 252 %token ELSE
 253
 254 %token<Cabs.cabsloc> ATTRIBUTE INLINE ASM TYPEOF FUNCTION__ PRETTY_FUNCTION__
 255 %token LABEL__
 256 %token<Cabs.cabsloc> BUILTIN_VA_ARG ATTRIBUTE_USED
 257 %token BUILTIN_VA_LIST
 258 %token BLOCKATTRIBUTE
 259 %token<Cabs.cabsloc> BUILTIN_TYPES_COMPAT BUILTIN_OFFSETOF
 260 %token<Cabs.cabsloc> DECLSPEC
 261 %token<string * Cabs.cabsloc> MSASM MSATTR
 262 %token<string * Cabs.cabsloc> PRAGMA_LINE
 263 %token PRAGMA_EOL
 264
 265 /* operator precedence */
 266 %nonassoc       IF
 267 %nonassoc       ELSE
 268
 269
 270 %left   COMMA
 271 %right  EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
 272                 AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
 273 %right  QUEST COLON
 274 %left   PIPE_PIPE
 275 %left   AND_AND
 276 %left   PIPE
 277 %left   CIRC
 278 %left   AND
 279 %left   EQ_EQ EXCLAM_EQ
 280 %left   INF SUP INF_EQ SUP_EQ
 281 %left   INF_INF SUP_SUP
 282 %left   PLUS MINUS
 283 %left   STAR SLASH PERCENT CONST RESTRICT VOLATILE
 284 %right  EXCLAM TILDE PLUS_PLUS MINUS_MINUS CAST RPAREN ADDROF SIZEOF ALIGNOF
 285 %left   LBRACKET
 286 %left   DOT ARROW LPAREN LBRACE
 287 %right  NAMED_TYPE     /* We'll use this to handle redefinitions of
 288                         * NAMED_TYPE as variables */
 289 %left   IDENT
 290
 291 /* Non-terminals informations */
 292 %start interpret file
 293 %type <Cabs.definition list> file interpret globals
 294
 295 %type <Cabs.definition> global
 296
 297
 298 %type <Cabs.attribute list> attributes attributes_with_asm asmattr
 299 %type <Cabs.statement> statement
 300 %type <Cabs.constant * cabsloc> constant
 301 %type <string * cabsloc> string_constant
 302 %type <Cabs.expression * cabsloc> expression
 303 %type <Cabs.expression> opt_expression
 304 %type <Cabs.init_expression> init_expression
 305 %type <Cabs.expression list * cabsloc> comma_expression
 306 %type <Cabs.expression list * cabsloc> paren_comma_expression
 307 %type <Cabs.expression list> arguments
 308 %type <Cabs.expression list> bracket_comma_expression
 309 %type <int64 list Queue.t * cabsloc> string_list
 310 %type <int64 list * cabsloc> wstring_list
 311
 312 %type <Cabs.initwhat * Cabs.init_expression> initializer
 313 %type <(Cabs.initwhat * Cabs.init_expression) list> initializer_list
 314 %type <Cabs.initwhat> init_designators init_designators_opt
 315
 316 %type <spec_elem list * cabsloc> decl_spec_list
 317 %type <typeSpecifier * cabsloc> type_spec
 318 %type <Cabs.field_group list> struct_decl_list
 319
 320
 321 %type <Cabs.name> old_proto_decl
 322 %type <Cabs.single_name> parameter_decl
 323 %type <Cabs.enum_item> enumerator
 324 %type <Cabs.enum_item list> enum_list
 325 %type <Cabs.definition> declaration function_def
 326 %type <cabsloc * spec_elem list * name> function_def_start
 327 %type <Cabs.spec_elem list * Cabs.decl_type> type_name
 328 %type <Cabs.block * cabsloc * cabsloc> block
 329 %type <Cabs.statement list> block_element_list
 330 %type <string list> local_labels local_label_names
 331 %type <string list> old_parameter_list_ne
 332
 333 %type <Cabs.init_name> init_declarator
 334 %type <Cabs.init_name list> init_declarator_list
 335 %type <Cabs.name> declarator
 336 %type <Cabs.name * expression option> field_decl
 337 %type <(Cabs.name * expression option) list> field_decl_list
 338 %type <string * Cabs.decl_type> direct_decl
 339 %type <Cabs.decl_type> abs_direct_decl abs_direct_decl_opt
 340 %type <Cabs.decl_type * Cabs.attribute list> abstract_decl
 341
 342  /* (* Each element is a "* <type_quals_opt>". *) */
 343 %type <attribute list list * cabsloc> pointer pointer_opt
 344 %type <Cabs.cabsloc> location
 345 %type <Cabs.spec_elem * cabsloc> cvspec
 346 %%
 347
 348 interpret:
 349   file EOF                              {$1}
 350 ;
 351 file: globals                           {$1}
 352 ;
 353 globals:
 354   /* empty */                           { [] }
 355 | global globals                        { $1 :: $2 }
 356 | SEMICOLON globals                     { $2 }
 357 ;
 358
 359 location:
 360    /* empty */                  { currentLoc () }  %prec IDENT
 361
 362
 363 /*** Global Definition ***/
 364 global:
 365 | declaration                           { $1 }
 366 | function_def                          { $1 }
 367 /*(* Some C header files ar shared with the C++ compiler and have linkage
 368    * specification *)*/
 369 | EXTERN string_constant declaration    { LINKAGE (fst $2, (*handleLoc*) (snd $2), [ $3 ]) }
 370 | EXTERN string_constant LBRACE globals RBRACE
 371                                         { LINKAGE (fst $2, (*handleLoc*) (snd $2), $4)  }
 372 | ASM LPAREN string_constant RPAREN SEMICOLON
 373                                         { GLOBASM (fst $3, (*handleLoc*) $1) }
 374 | pragma                                { $1 }
 375 /* (* Old-style function prototype. This should be somewhere else, like in
 376     * "declaration". For now we keep it at global scope only because in local
 377     * scope it looks too much like a function call  *) */
 378 | IDENT LPAREN old_parameter_list_ne RPAREN old_pardef_list SEMICOLON
 379                            { (* Convert pardecl to new style *)
 380                              let pardecl, isva = doOldParDecl $3 $5 in
 381                              (* Make the function declarator *)
 382                              doDeclaration ((*handleLoc*) (snd $1)) []
 383                                [((fst $1, PROTO(JUSTBASE, pardecl,isva), [], cabslu),
 384                                  NO_INIT)]
 385                             }
 386 /* (* Old style function prototype, but without any arguments *) */
 387 | IDENT LPAREN RPAREN  SEMICOLON
 388                            { (* Make the function declarator *)
 389                              doDeclaration ((*handleLoc*)(snd $1)) []
 390                                [((fst $1, PROTO(JUSTBASE,[],false), [], cabslu),
 391                                  NO_INIT)]
 392                             }
 393 /* | location error SEMICOLON { PRAGMA (VARIABLE "parse_error", $1) } */
 394 ;
 395
 396 id_or_typename:
 397     IDENT                               {fst $1}
 398 |   NAMED_TYPE                          {fst $1}
 399 ;
 400
 401 maybecomma:
 402    /* empty */                          { () }
 403 |  COMMA                                { () }
 404 ;
 405
 406 /* *** Expressions *** */
 407
 408 primary_expression:                     /*(* 6.5.1. *)*/
 409 |               IDENT
 410                         {VARIABLE (fst $1), snd $1}
 411 |               constant
 412                         {CONSTANT (fst $1), snd $1}
 413 |               paren_comma_expression
 414                         {PAREN (smooth_expression (fst $1)), snd $1}
 415 |               LPAREN block RPAREN
 416                         { GNU_BODY (fst3 $2), $1 }
 417 ;
 418
 419 postfix_expression:                     /*(* 6.5.2 *)*/
 420 |               primary_expression
 421                         { $1 }
 422 |               postfix_expression bracket_comma_expression
 423                         {INDEX (fst $1, smooth_expression $2), snd $1}
 424 |               postfix_expression LPAREN arguments RPAREN
 425                         {CALL (fst $1, $3), snd $1}
 426 |               BUILTIN_VA_ARG LPAREN expression COMMA type_name RPAREN
 427                         { let b, d = $5 in
 428                           CALL (VARIABLE "__builtin_va_arg",
 429                                 [fst $3; TYPE_SIZEOF (b, d)]), $1 }
 430 |               BUILTIN_TYPES_COMPAT LPAREN type_name COMMA type_name RPAREN
 431                         { let b1,d1 = $3 in
 432                           let b2,d2 = $5 in
 433                           CALL (VARIABLE "__builtin_types_compatible_p",
 434                                 [TYPE_SIZEOF(b1,d1); TYPE_SIZEOF(b2,d2)]), $1 }
 435 |               BUILTIN_OFFSETOF LPAREN type_name COMMA offsetof_member_designator RPAREN
 436                         { transformOffsetOf $3 $5, $1 }
 437 |               postfix_expression DOT id_or_typename
 438                         {MEMBEROF (fst $1, $3), snd $1}
 439 |               postfix_expression ARROW id_or_typename
 440                         {MEMBEROFPTR (fst $1, $3), snd $1}
 441 |               postfix_expression PLUS_PLUS
 442                         {UNARY (POSINCR, fst $1), snd $1}
 443 |               postfix_expression MINUS_MINUS
 444                         {UNARY (POSDECR, fst $1), snd $1}
 445 /* (* We handle GCC constructor expressions *) */
 446 |               LPAREN type_name RPAREN LBRACE initializer_list_opt RBRACE
 447                         { CAST($2, COMPOUND_INIT $5), $1 }
 448 ;
 449
 450 offsetof_member_designator:     /* GCC extension for __builtin_offsetof */
 451 |               id_or_typename
 452                         { VARIABLE ($1) }
 453 |               offsetof_member_designator DOT IDENT
 454                         { MEMBEROF ($1, fst $3) }
 455 |               offsetof_member_designator bracket_comma_expression
 456                         { INDEX ($1, smooth_expression $2) }
 457 ;
 458
 459 unary_expression:   /*(* 6.5.3 *)*/
 460 |               postfix_expression
 461                         { $1 }
 462 |               PLUS_PLUS unary_expression
 463                         {UNARY (PREINCR, fst $2), $1}
 464 |               MINUS_MINUS unary_expression
 465                         {UNARY (PREDECR, fst $2), $1}
 466 |               SIZEOF unary_expression
 467                         {EXPR_SIZEOF (fst $2), $1}
 468 |               SIZEOF LPAREN type_name RPAREN
 469                         {let b, d = $3 in TYPE_SIZEOF (b, d), $1}
 470 |               ALIGNOF unary_expression
 471                         {EXPR_ALIGNOF (fst $2), $1}
 472 |               ALIGNOF LPAREN type_name RPAREN
 473                         {let b, d = $3 in TYPE_ALIGNOF (b, d), $1}
 474 |               PLUS cast_expression
 475                         {UNARY (PLUS, fst $2), $1}
 476 |               MINUS cast_expression
 477                         {UNARY (MINUS, fst $2), $1}
 478 |               STAR cast_expression
 479                         {UNARY (MEMOF, fst $2), $1}
 480 |               AND cast_expression
 481                         {UNARY (ADDROF, fst $2), $1}
 482 |               EXCLAM cast_expression
 483                         {UNARY (NOT, fst $2), $1}
 484 |               TILDE cast_expression
 485                         {UNARY (BNOT, fst $2), $1}
 486 |               AND_AND IDENT  { LABELADDR (fst $2), $1 }
 487 ;
 488
 489 cast_expression:   /*(* 6.5.4 *)*/
 490 |              unary_expression
 491                          { $1 }
 492 |               LPAREN type_name RPAREN cast_expression
 493                          { CAST($2, SINGLE_INIT (fst $4)), $1 }
 494 ;
 495
 496 multiplicative_expression:  /*(* 6.5.5 *)*/
 497 |               cast_expression
 498                          { $1 }
 499 |               multiplicative_expression STAR cast_expression
 500                         {BINARY(MUL, fst $1, fst $3), snd $1}
 501 |               multiplicative_expression SLASH cast_expression
 502                         {BINARY(DIV, fst $1, fst $3), snd $1}
 503 |               multiplicative_expression PERCENT cast_expression
 504                         {BINARY(MOD, fst $1, fst $3), snd $1}
 505 ;
 506
 507 additive_expression:  /*(* 6.5.6 *)*/
 508 |               multiplicative_expression
 509                         { $1 }
 510 |               additive_expression PLUS multiplicative_expression
 511                         {BINARY(ADD, fst $1, fst $3), snd $1}
 512 |               additive_expression MINUS multiplicative_expression
 513                         {BINARY(SUB, fst $1, fst $3), snd $1}
 514 ;
 515
 516 shift_expression:      /*(* 6.5.7 *)*/
 517 |               additive_expression
 518                          { $1 }
 519 |               shift_expression  INF_INF additive_expression
 520                         {BINARY(SHL, fst $1, fst $3), snd $1}
 521 |               shift_expression  SUP_SUP additive_expression
 522                         {BINARY(SHR, fst $1, fst $3), snd $1}
 523 ;
 524
 525
 526 relational_expression:   /*(* 6.5.8 *)*/
 527 |               shift_expression
 528                         { $1 }
 529 |               relational_expression INF shift_expression
 530                         {BINARY(LT, fst $1, fst $3), snd $1}
 531 |               relational_expression SUP shift_expression
 532                         {BINARY(GT, fst $1, fst $3), snd $1}
 533 |               relational_expression INF_EQ shift_expression
 534                         {BINARY(LE, fst $1, fst $3), snd $1}
 535 |               relational_expression SUP_EQ shift_expression
 536                         {BINARY(GE, fst $1, fst $3), snd $1}
 537 ;
 538
 539 equality_expression:   /*(* 6.5.9 *)*/
 540 |              relational_expression
 541                         { $1 }
 542 |               equality_expression EQ_EQ relational_expression
 543                         {BINARY(EQ, fst $1, fst $3), snd $1}
 544 |               equality_expression EXCLAM_EQ relational_expression
 545                         {BINARY(NE, fst $1, fst $3), snd $1}
 546 ;
 547
 548
 549 bitwise_and_expression:   /*(* 6.5.10 *)*/
 550 |               equality_expression
 551                        { $1 }
 552 |               bitwise_and_expression AND equality_expression
 553                         {BINARY(BAND, fst $1, fst $3), snd $1}
 554 ;
 555
 556 bitwise_xor_expression:   /*(* 6.5.11 *)*/
 557 |               bitwise_and_expression
 558                        { $1 }
 559 |               bitwise_xor_expression CIRC bitwise_and_expression
 560                         {BINARY(XOR, fst $1, fst $3), snd $1}
 561 ;
 562
 563 bitwise_or_expression:   /*(* 6.5.12 *)*/
 564 |               bitwise_xor_expression
 565                         { $1 }
 566 |               bitwise_or_expression PIPE bitwise_xor_expression
 567                         {BINARY(BOR, fst $1, fst $3), snd $1}
 568 ;
 569
 570 logical_and_expression:   /*(* 6.5.13 *)*/
 571 |               bitwise_or_expression
 572                         { $1 }
 573 |               logical_and_expression AND_AND bitwise_or_expression
 574                         {BINARY(AND, fst $1, fst $3), snd $1}
 575 ;
 576
 577 logical_or_expression:   /*(* 6.5.14 *)*/
 578 |               logical_and_expression
 579                         { $1 }
 580 |               logical_or_expression PIPE_PIPE logical_and_expression
 581                         {BINARY(OR, fst $1, fst $3), snd $1}
 582 ;
 583
 584 conditional_expression:    /*(* 6.5.15 *)*/
 585 |               logical_or_expression
 586                          { $1 }
 587 |               logical_or_expression QUEST opt_expression COLON conditional_expression
 588                         {QUESTION (fst $1, $3, fst $5), snd $1}
 589 ;
 590
 591 /*(* The C spec says that left-hand sides of assignment expressions are unary
 592  * expressions. GCC allows cast expressions in there ! *)*/
 593
 594 assignment_expression:     /*(* 6.5.16 *)*/
 595 |               conditional_expression
 596                          { $1 }
 597 |               cast_expression EQ assignment_expression
 598                         {BINARY(ASSIGN, fst $1, fst $3), snd $1}
 599 |               cast_expression PLUS_EQ assignment_expression
 600                         {BINARY(ADD_ASSIGN, fst $1, fst $3), snd $1}
 601 |               cast_expression MINUS_EQ assignment_expression
 602                         {BINARY(SUB_ASSIGN, fst $1, fst $3), snd $1}
 603 |               cast_expression STAR_EQ assignment_expression
 604                         {BINARY(MUL_ASSIGN, fst $1, fst $3), snd $1}
 605 |               cast_expression SLASH_EQ assignment_expression
 606                         {BINARY(DIV_ASSIGN, fst $1, fst $3), snd $1}
 607 |               cast_expression PERCENT_EQ assignment_expression
 608                         {BINARY(MOD_ASSIGN, fst $1, fst $3), snd $1}
 609 |               cast_expression AND_EQ assignment_expression
 610                         {BINARY(BAND_ASSIGN, fst $1, fst $3), snd $1}
 611 |               cast_expression PIPE_EQ assignment_expression
 612                         {BINARY(BOR_ASSIGN, fst $1, fst $3), snd $1}
 613 |               cast_expression CIRC_EQ assignment_expression
 614                         {BINARY(XOR_ASSIGN, fst $1, fst $3), snd $1}
 615 |               cast_expression INF_INF_EQ assignment_expression
 616                         {BINARY(SHL_ASSIGN, fst $1, fst $3), snd $1}
 617 |               cast_expression SUP_SUP_EQ assignment_expression
 618                         {BINARY(SHR_ASSIGN, fst $1, fst $3), snd $1}
 619 ;
 620
 621 expression:           /*(* 6.5.17 *)*/
 622                 assignment_expression
 623                         { $1 }
 624 ;
 625
 626
 627 constant:
 628     CST_INT                             {CONST_INT (fst $1), snd $1}
 629 |   CST_FLOAT                           {CONST_FLOAT (fst $1), snd $1}
 630 |   CST_CHAR                            {CONST_CHAR (fst $1), snd $1}
 631 |   CST_WCHAR                           {CONST_WCHAR (fst $1), snd $1}
 632 |   string_constant                     {CONST_STRING (fst $1), snd $1}
 633 |   wstring_list                        {CONST_WSTRING (fst $1), snd $1}
 634 ;
 635
 636 string_constant:
 637 /* Now that we know this constant isn't part of a wstring, convert it
 638    back to a string for easy viewing. */
 639     string_list                         {
 640      let queue, location = $1 in
 641      let buffer = Buffer.create (Queue.length queue) in
 642      Queue.iter
 643        (List.iter
 644           (fun value ->
 645             let char = int64_to_char value in
 646             Buffer.add_char buffer char))
 647        queue;
 648      Buffer.contents buffer, location
 649    }
 650 ;
 651 one_string_constant:
 652 /* Don't concat multiple strings.  For asm templates. */
 653     CST_STRING                          {intlist_to_string (fst $1) }
 654 ;
 655 string_list:
 656     one_string                          {
 657       let queue = Queue.create () in
 658       Queue.add (fst $1) queue;
 659       queue, snd $1
 660     }
 661 |   string_list one_string              {
 662       Queue.add (fst $2) (fst $1);
 663       $1
 664     }
 665 ;
 666
 667 wstring_list:
 668     CST_WSTRING                         { $1 }
 669 |   wstring_list one_string             { (fst $1) @ (fst $2), snd $1 }
 670 |   wstring_list CST_WSTRING            { (fst $1) @ (fst $2), snd $1 }
 671 /* Only the first string in the list needs an L, so L"a" "b" is the same
 672  * as L"ab" or L"a" L"b". */
 673
 674 one_string:
 675     CST_STRING                          {$1}
 676 |   FUNCTION__                          {(Cabshelper.explodeStringToInts
 677                                             !currentFunctionName), $1}
 678 |   PRETTY_FUNCTION__                   {(Cabshelper.explodeStringToInts
 679                                             !currentFunctionName), $1}
 680 ;
 681
 682 init_expression:
 683      expression         { SINGLE_INIT (fst $1) }
 684 |    LBRACE initializer_list_opt RBRACE
 685                         { COMPOUND_INIT $2}
 686
 687 initializer_list:    /* ISO 6.7.8. Allow a trailing COMMA */
 688     initializer                             { [$1] }
 689 |   initializer COMMA initializer_list_opt  { $1 :: $3 }
 690 ;
 691 initializer_list_opt:
 692     /* empty */                             { [] }
 693 |   initializer_list                        { $1 }
 694 ;
 695 initializer:
 696     init_designators eq_opt init_expression { ($1, $3) }
 697 |   gcc_init_designators init_expression { ($1, $2) }
 698 |                       init_expression { (NEXT_INIT, $1) }
 699 ;
 700 eq_opt:
 701    EQ                        { () }
 702    /*(* GCC allows missing = *)*/
 703 |  /*(* empty *)*/               { () }
 704 ;
 705 init_designators:
 706     DOT id_or_typename init_designators_opt      { INFIELD_INIT($2, $3) }
 707 |   LBRACKET  expression RBRACKET init_designators_opt
 708                                         { ATINDEX_INIT(fst $2, $4) }
 709 |   LBRACKET  expression ELLIPSIS expression RBRACKET
 710                                         { ATINDEXRANGE_INIT(fst $2, fst $4) }
 711 ;
 712 init_designators_opt:
 713    /* empty */                          { NEXT_INIT }
 714 |  init_designators                     { $1 }
 715 ;
 716
 717 gcc_init_designators:  /*(* GCC supports these strange things *)*/
 718    id_or_typename COLON                 { INFIELD_INIT($1, NEXT_INIT) }
 719 ;
 720
 721 arguments:
 722                 /* empty */         { [] }
 723 |               comma_expression    { fst $1 }
 724 ;
 725
 726 opt_expression:
 727                 /* empty */
 728                         {NOTHING}
 729 |               comma_expression
 730                         {smooth_expression (fst $1)}
 731 ;
 732
 733 comma_expression:
 734                 expression                        {[fst $1], snd $1}
 735 |               expression COMMA comma_expression { fst $1 :: fst $3, snd $1 }
 736 |               error COMMA comma_expression      { $3 }
 737 ;
 738
 739 comma_expression_opt:
 740                 /* empty */         { NOTHING }
 741 |               comma_expression    { smooth_expression (fst $1) }
 742 ;
 743
 744 paren_comma_expression:
 745   LPAREN comma_expression RPAREN                   { $2 }
 746 | LPAREN error RPAREN                              { [], $1 }
 747 ;
 748
 749 bracket_comma_expression:
 750   LBRACKET comma_expression RBRACKET                   { fst $2 }
 751 | LBRACKET error RBRACKET                              { [] }
 752 ;
 753
 754
 755 /*** statements ***/
 756 block: /* ISO 6.8.2 */
 757     block_begin local_labels block_attrs block_element_list RBRACE
 758                                          {!pop_context();
 759                                           { blabels = $2;
 760                                             battrs = $3;
 761                                             bstmts = $4 },
 762                                             $1, $5
 763                                          }
 764 |   error location RBRACE                { { blabels = [];
 765                                              battrs  = [];
 766                                              bstmts  = [] },
 767                                              $2, $3
 768                                          }
 769 ;
 770 block_begin:
 771     LBRACE                               {!push_context (); $1}
 772 ;
 773
 774 block_attrs:
 775    /* empty */                                              { [] }
 776 |  BLOCKATTRIBUTE paren_attr_list_ne
 777                                         { [("__blockattribute__", $2)] }
 778 ;
 779
 780 /* statements and declarations in a block, in any order (for C99 support) */
 781 block_element_list:
 782     /* empty */                          { [] }
 783 |   declaration block_element_list       { DEFINITION($1) :: $2 }
 784 |   statement block_element_list         { $1 :: $2 }
 785 /*(* GCC accepts a label at the end of a block *)*/
 786 |   IDENT COLON                          { [ LABEL (fst $1, NOP (snd $1),
 787                                                     snd $1)] }
 788 |   pragma block_element_list            { $2 }
 789 ;
 790
 791 local_labels:
 792    /* empty */                                       { [] }
 793 |  LABEL__ local_label_names SEMICOLON local_labels  { $2 @ $4 }
 794 ;
 795 local_label_names:
 796    IDENT                                 { [ fst $1 ] }
 797 |  IDENT COMMA local_label_names         { fst $1 :: $3 }
 798 ;
 799
 800
 801
 802 statement:
 803     SEMICOLON           {NOP ((*handleLoc*) $1) }
 804 |   comma_expression SEMICOLON
 805                         {COMPUTATION (smooth_expression (fst $1), (*handleLoc*)(snd $1))}
 806 |   block               {BLOCK (fst3 $1, (*handleLoc*)(snd3 $1))}
 807 |   IF paren_comma_expression statement                    %prec IF
 808                         {IF (smooth_expression (fst $2), $3, NOP $1, $1)}
 809 |   IF paren_comma_expression statement ELSE statement
 810                         {IF (smooth_expression (fst $2), $3, $5, (*handleLoc*) $1)}
 811 |   SWITCH paren_comma_expression statement
 812                         {SWITCH (smooth_expression (fst $2), $3, (*handleLoc*) $1)}
 813 |   WHILE paren_comma_expression statement
 814                         {WHILE (smooth_expression (fst $2), $3, (*handleLoc*) $1)}
 815 |   DO statement WHILE paren_comma_expression SEMICOLON
 816                                  {DOWHILE (smooth_expression (fst $4), $2, (*handleLoc*) $1)}
 817 |   FOR LPAREN for_clause opt_expression
 818                 SEMICOLON opt_expression RPAREN statement
 819                                  {FOR ($3, $4, $6, $8, (*handleLoc*) $1)}
 820 |   IDENT COLON attribute_nocv_list statement
 821                                  {(* The only attribute that should appear here
 822                                      is "unused". For now, we drop this on the
 823                                      floor, since unused labels are usually
 824                                      removed anyways by Rmtmps. *)
 825                                   LABEL (fst $1, $4, (snd $1))}
 826 |   CASE expression COLON statement
 827                                  {CASE (fst $2, $4, (*handleLoc*) $1)}
 828 |   CASE expression ELLIPSIS expression COLON statement
 829                                  {CASERANGE (fst $2, fst $4, $6, (*handleLoc*) $1)}
 830 |   DEFAULT COLON
 831                                  {DEFAULT (NOP $1, (*handleLoc*) $1)}
 832 |   RETURN SEMICOLON             {RETURN (NOTHING, (*handleLoc*) $1)}
 833 |   RETURN comma_expression SEMICOLON
 834                                  {RETURN (smooth_expression (fst $2), (*handleLoc*) $1)}
 835 |   BREAK SEMICOLON     {BREAK ((*handleLoc*) $1)}
 836 |   CONTINUE SEMICOLON   {CONTINUE ((*handleLoc*) $1)}
 837 |   GOTO IDENT SEMICOLON
 838                                  {GOTO (fst $2, (*handleLoc*) $1)}
 839 |   GOTO STAR comma_expression SEMICOLON
 840                                  { COMPGOTO (smooth_expression (fst $3), (*handleLoc*) $1) }
 841 |   ASM asmattr LPAREN asmtemplate asmoutputs RPAREN SEMICOLON
 842                         { ASM ($2, $4, $5, (*handleLoc*) $1) }
 843 |   MSASM               { ASM ([], [fst $1], None, (*handleLoc*)(snd $1))}
 844 |   TRY block EXCEPT paren_comma_expression block
 845                         { let b, _, _ = $2 in
 846                           let h, _, _ = $5 in
 847                           if not !msvcMode then
 848                             parse_error "try/except in GCC code";
 849                           TRY_EXCEPT (b, COMMA (fst $4), h, (*handleLoc*) $1) }
 850 |   TRY block FINALLY block
 851                         { let b, _, _ = $2 in
 852                           let h, _, _ = $4 in
 853                           if not !msvcMode then
 854                             parse_error "try/finally in GCC code";
 855                           TRY_FINALLY (b, h, (*handleLoc*) $1) }
 856
 857 |   error location   SEMICOLON   { (NOP $2)}
 858 ;
 859
 860
 861 for_clause:
 862     opt_expression SEMICOLON     { FC_EXP $1 }
 863 |   declaration                  { FC_DECL $1 }
 864 ;
 865
 866 declaration:                                /* ISO 6.7.*/
 867     decl_spec_list init_declarator_list SEMICOLON
 868                                        { doDeclaration ((*handleLoc*)(snd $1)) (fst $1) $2 }
 869 |   decl_spec_list SEMICOLON
 870                                        { doDeclaration ((*handleLoc*)(snd $1)) (fst $1) [] }
 871 ;
 872 init_declarator_list:                       /* ISO 6.7 */
 873     init_declarator                              { [$1] }
 874 |   init_declarator COMMA init_declarator_list   { $1 :: $3 }
 875
 876 ;
 877 init_declarator:                             /* ISO 6.7 */
 878     declarator                          { ($1, NO_INIT) }
 879 |   declarator EQ init_expression
 880                                         { ($1, $3) }
 881 ;
 882
 883 decl_spec_list:                         /* ISO 6.7 */
 884                                         /* ISO 6.7.1 */
 885 |   TYPEDEF decl_spec_list_opt          { SpecTypedef :: $2, $1  }
 886 |   EXTERN decl_spec_list_opt           { SpecStorage EXTERN :: $2, $1 }
 887 |   STATIC  decl_spec_list_opt          { SpecStorage STATIC :: $2, $1 }
 888 |   AUTO   decl_spec_list_opt           { SpecStorage AUTO :: $2, $1 }
 889 |   REGISTER decl_spec_list_opt         { SpecStorage REGISTER :: $2, $1}
 890                                         /* ISO 6.7.2 */
 891 |   type_spec decl_spec_list_opt_no_named { SpecType (fst $1) :: $2, snd $1 }
 892                                         /* ISO 6.7.4 */
 893 |   INLINE decl_spec_list_opt           { SpecInline :: $2, $1 }
 894 |   cvspec decl_spec_list_opt           { (fst $1) :: $2, snd $1 }
 895 |   attribute_nocv decl_spec_list_opt   { SpecAttr (fst $1) :: $2, snd $1 }
 896 ;
 897 /* (* In most cases if we see a NAMED_TYPE we must shift it. Thus we declare
 898     * NAMED_TYPE to have right associativity  *) */
 899 decl_spec_list_opt:
 900     /* empty */                         { [] } %prec NAMED_TYPE
 901 |   decl_spec_list                      { fst $1 }
 902 ;
 903 /* (* We add this separate rule to handle the special case when an appearance
 904     * of NAMED_TYPE should not be considered as part of the specifiers but as
 905     * part of the declarator. IDENT has higher precedence than NAMED_TYPE  *)
 906  */
 907 decl_spec_list_opt_no_named:
 908     /* empty */                         { [] } %prec IDENT
 909 |   decl_spec_list                      { fst $1 }
 910 ;
 911 type_spec:   /* ISO 6.7.2 */
 912     VOID            { Tvoid, $1}
 913 |   UNDERSCORE_BOOL { T_Bool, $1 }
 914 |   CHAR            { Tchar, $1 }
 915 |   SHORT           { Tshort, $1 }
 916 |   INT             { Tint, $1 }
 917 |   LONG            { Tlong, $1 }
 918 |   INT64           { Tint64, $1 }
 919 |   FLOAT           { Tfloat, $1 }
 920 |   DOUBLE          { Tdouble, $1 }
 921 |   SIGNED          { Tsigned, $1 }
 922 |   UNSIGNED        { Tunsigned, $1 }
 923 |   STRUCT                 id_or_typename
 924                                                    { Tstruct ($2, None,    []), $1 }
 925 |   STRUCT just_attributes id_or_typename
 926                                                    { Tstruct ($3, None,    $2), $1 }
 927 |   STRUCT                 id_or_typename LBRACE struct_decl_list RBRACE
 928                                                    { Tstruct ($2, Some $4, []), $1 }
 929 |   STRUCT                                LBRACE struct_decl_list RBRACE
 930                                                    { Tstruct ("", Some $3, []), $1 }
 931 |   STRUCT just_attributes id_or_typename LBRACE struct_decl_list RBRACE
 932                                                    { Tstruct ($3, Some $5, $2), $1 }
 933 |   STRUCT just_attributes                LBRACE struct_decl_list RBRACE
 934                                                    { Tstruct ("", Some $4, $2), $1 }
 935 |   UNION                  id_or_typename
 936                                                    { Tunion  ($2, None,    []), $1 }
 937 |   UNION                  id_or_typename LBRACE struct_decl_list RBRACE
 938                                                    { Tunion  ($2, Some $4, []), $1 }
 939 |   UNION                                 LBRACE struct_decl_list RBRACE
 940                                                    { Tunion  ("", Some $3, []), $1 }
 941 |   UNION  just_attributes id_or_typename LBRACE struct_decl_list RBRACE
 942                                                    { Tunion  ($3, Some $5, $2), $1 }
 943 |   UNION  just_attributes                LBRACE struct_decl_list RBRACE
 944                                                    { Tunion  ("", Some $4, $2), $1 }
 945 |   ENUM                   id_or_typename
 946                                                    { Tenum   ($2, None,    []), $1 }
 947 |   ENUM                   id_or_typename LBRACE enum_list maybecomma RBRACE
 948                                                    { Tenum   ($2, Some $4, []), $1 }
 949 |   ENUM                                  LBRACE enum_list maybecomma RBRACE
 950                                                    { Tenum   ("", Some $3, []), $1 }
 951 |   ENUM   just_attributes id_or_typename LBRACE enum_list maybecomma RBRACE
 952                                                    { Tenum   ($3, Some $5, $2), $1 }
 953 |   ENUM   just_attributes                LBRACE enum_list maybecomma RBRACE
 954                                                    { Tenum   ("", Some $4, $2), $1 }
 955 |   NAMED_TYPE      { Tnamed (fst $1), snd $1 }
 956 |   TYPEOF LPAREN expression RPAREN     { TtypeofE (fst $3), $1 }
 957 |   TYPEOF LPAREN type_name RPAREN      { let s, d = $3 in
 958                                           TtypeofT (s, d), $1 }
 959 ;
 960 struct_decl_list: /* (* ISO 6.7.2. Except that we allow empty structs. We
 961                       * also allow missing field names. *)
 962                    */
 963    /* empty */                           { [] }
 964 |  decl_spec_list                 SEMICOLON struct_decl_list
 965                                          { (fst $1,
 966                                             [(missingFieldDecl, None)]) :: $3 }
 967 /*(* GCC allows extra semicolons *)*/
 968 |                                 SEMICOLON struct_decl_list
 969                                          { $2 }
 970 |  decl_spec_list field_decl_list SEMICOLON struct_decl_list
 971                                           { (fst $1, $2)
 972                                             :: $4 }
 973 /*(* MSVC allows pragmas in strange places *)*/
 974 |  pragma struct_decl_list                { $2 }
 975
 976 |  error                          SEMICOLON struct_decl_list
 977                                           { $3 }
 978 ;
 979 field_decl_list: /* (* ISO 6.7.2 *) */
 980     field_decl                           { [$1] }
 981 |   field_decl COMMA field_decl_list     { $1 :: $3 }
 982 ;
 983 field_decl: /* (* ISO 6.7.2. Except that we allow unnamed fields. *) */
 984 |   declarator                      { ($1, None) }
 985 |   declarator COLON expression attributes
 986                                     { let (n,decl,al,loc) = $1 in
 987                                       let al' = al @ $4 in
 988                                      ((n,decl,al',loc), Some (fst $3)) }
 989 |              COLON expression     { (missingFieldDecl, Some (fst $2)) }
 990 ;
 991
 992 enum_list: /* (* ISO 6.7.2.2 *) */
 993     enumerator                          {[$1]}
 994 |   enum_list COMMA enumerator          {$1 @ [$3]}
 995 |   enum_list COMMA error               { $1 }
 996 ;
 997 enumerator:
 998     IDENT                       {(fst $1, NOTHING, snd $1)}
 999 |   IDENT EQ expression         {(fst $1, fst $3, snd $1)}
1000 ;
1001
1002
1003 declarator:  /* (* ISO 6.7.5. Plus Microsoft declarators.*) */
1004    pointer_opt direct_decl attributes_with_asm
1005                                { let (n, decl) = $2 in
1006                                 (n, applyPointer (fst $1) decl, $3, (snd $1)) }
1007 ;
1008
1009
1010 direct_decl: /* (* ISO 6.7.5 *) */
1011                                    /* (* We want to be able to redefine named
1012                                     * types as variable names *) */
1013 |   id_or_typename                 { ($1, JUSTBASE) }
1014
1015 |   LPAREN attributes declarator RPAREN
1016                                    { let (n,decl,al,loc) = $3 in
1017                                      (n, PARENTYPE($2,decl,al)) }
1018
1019 |   direct_decl LBRACKET attributes comma_expression_opt RBRACKET
1020                                    { let (n, decl) = $1 in
1021                                      (n, ARRAY(decl, $3, $4)) }
1022 |   direct_decl LBRACKET attributes error RBRACKET
1023                                    { let (n, decl) = $1 in
1024                                      (n, ARRAY(decl, $3, NOTHING)) }
1025 |   direct_decl parameter_list_startscope rest_par_list RPAREN
1026                                    { let (n, decl) = $1 in
1027                                      let (params, isva) = $3 in
1028                                      !pop_context ();
1029                                      (n, PROTO(decl, params, isva))
1030                                    }
1031 ;
1032 parameter_list_startscope:
1033     LPAREN                         { !push_context () }
1034 ;
1035 rest_par_list:
1036 |   /* empty */                    { ([], false) }
1037 |   parameter_decl rest_par_list1  { let (params, isva) = $2 in
1038                                      ($1 :: params, isva)
1039                                    }
1040 ;
1041 rest_par_list1:
1042     /* empty */                         { ([], false) }
1043 |   COMMA ELLIPSIS                      { ([], true) }
1044 |   COMMA parameter_decl rest_par_list1 { let (params, isva) = $3 in
1045                                           ($2 :: params, isva)
1046                                         }
1047 ;
1048
1049
1050 parameter_decl: /* (* ISO 6.7.5 *) */
1051    decl_spec_list declarator              { (fst $1, $2) }
1052 |  decl_spec_list abstract_decl           { let d, a = $2 in
1053                                             (fst $1, ("", d, a, cabslu)) }
1054 |  decl_spec_list                         { (fst $1, ("", JUSTBASE, [], cabslu)) }
1055 |  LPAREN parameter_decl RPAREN           { $2 }
1056 ;
1057
1058 /* (* Old style prototypes. Like a declarator *) */
1059 old_proto_decl:
1060   pointer_opt direct_old_proto_decl   { let (n, decl, a) = $2 in
1061                                           (n, applyPointer (fst $1) decl,
1062                                            a, snd $1)
1063                                       }
1064
1065 ;
1066
1067 direct_old_proto_decl:
1068   direct_decl LPAREN old_parameter_list_ne RPAREN old_pardef_list
1069                                    { let par_decl, isva = doOldParDecl $3 $5 in
1070                                      let n, decl = $1 in
1071                                      (n, PROTO(decl, par_decl, isva), [])
1072                                    }
1073 | direct_decl LPAREN                       RPAREN
1074                                    { let n, decl = $1 in
1075                                      (n, PROTO(decl, [], false), [])
1076                                    }
1077
1078 /* (* appears sometimesm but generates a shift-reduce conflict. *)
1079 | LPAREN STAR direct_decl LPAREN old_parameter_list_ne RPAREN RPAREN LPAREN RPAREN old_pardef_list
1080                                    { let par_decl, isva
1081                                              = doOldParDecl $5 $10 in
1082                                      let n, decl = $3 in
1083                                      (n, PROTO(decl, par_decl, isva), [])
1084                                    }
1085 */
1086 ;
1087
1088 old_parameter_list_ne:
1089 |  IDENT                                       { [fst $1] }
1090 |  IDENT COMMA old_parameter_list_ne           { let rest = $3 in
1091                                                  (fst $1 :: rest) }
1092 ;
1093
1094 old_pardef_list:
1095    /* empty */                            { ([], false) }
1096 |  decl_spec_list old_pardef SEMICOLON ELLIPSIS
1097                                           { ([(fst $1, $2)], true) }
1098 |  decl_spec_list old_pardef SEMICOLON old_pardef_list
1099                                           { let rest, isva = $4 in
1100                                             ((fst $1, $2) :: rest, isva)
1101                                           }
1102 ;
1103
1104 old_pardef:
1105    declarator                             { [$1] }
1106 |  declarator COMMA old_pardef            { $1 :: $3 }
1107 |  error                                  { [] }
1108 ;
1109
1110
1111 pointer: /* (* ISO 6.7.5 *) */
1112    STAR attributes pointer_opt  { $2 :: fst $3, $1 }
1113 ;
1114 pointer_opt:
1115    /**/                          { let l = currentLoc () in
1116                                    ([], l) }
1117 |  pointer                       { $1 }
1118 ;
1119
1120 type_name: /* (* ISO 6.7.6 *) */
1121   decl_spec_list abstract_decl { let d, a = $2 in
1122                                  if a <> [] then begin
1123                                    parse_error "attributes in type name";
1124                                    raise Parsing.Parse_error
1125                                  end;
1126                                  (fst $1, d)
1127                                }
1128 | decl_spec_list               { (fst $1, JUSTBASE) }
1129 ;
1130 abstract_decl: /* (* ISO 6.7.6. *) */
1131   pointer_opt abs_direct_decl attributes  { applyPointer (fst $1) $2, $3 }
1132 | pointer                                 { applyPointer (fst $1) JUSTBASE, [] }
1133 ;
1134
1135 abs_direct_decl: /* (* ISO 6.7.6. We do not support optional declarator for
1136                      * functions. Plus Microsoft attributes. See the
1137                      * discussion for declarator. *) */
1138 |   LPAREN attributes abstract_decl RPAREN
1139                                    { let d, a = $3 in
1140                                      PARENTYPE ($2, d, a)
1141                                    }
1142
1143 |   LPAREN error RPAREN
1144                                    { JUSTBASE }
1145
1146 |   abs_direct_decl_opt LBRACKET comma_expression_opt RBRACKET
1147                                    { ARRAY($1, [], $3) }
1148 /*(* The next should be abs_direct_decl_opt but we get conflicts *)*/
1149 |   abs_direct_decl  parameter_list_startscope rest_par_list RPAREN
1150                                    { let (params, isva) = $3 in
1151                                      !pop_context ();
1152                                      PROTO ($1, params, isva)
1153                                    }
1154 ;
1155 abs_direct_decl_opt:
1156     abs_direct_decl                 { $1 }
1157 |   /* empty */                     { JUSTBASE }
1158 ;
1159 function_def:  /* (* ISO 6.9.1 *) */
1160   function_def_start block
1161           { let (loc, specs, decl) = $1 in
1162             currentFunctionName := "<__FUNCTION__ used outside any functions>";
1163             !pop_context (); (* The context pushed by
1164                                     * announceFunctionName *)
1165             doFunctionDef ((*handleLoc*) loc) (trd3 $2) specs decl (fst3 $2)
1166           }
1167
1168
1169 function_def_start:  /* (* ISO 6.9.1 *) */
1170   decl_spec_list declarator
1171                             { announceFunctionName $2;
1172                               (snd $1, fst $1, $2)
1173                             }
1174
1175 /* (* Old-style function prototype *) */
1176 | decl_spec_list old_proto_decl
1177                             { announceFunctionName $2;
1178                               (snd $1, fst $1, $2)
1179                             }
1180 /* (* New-style function that does not have a return type *) */
1181 | IDENT parameter_list_startscope rest_par_list RPAREN
1182                            { let (params, isva) = $3 in
1183                              let fdec =
1184                                (fst $1, PROTO(JUSTBASE, params, isva), [], snd $1) in
1185                              announceFunctionName fdec;
1186                              (* Default is int type *)
1187                              let defSpec = [SpecType Tint] in
1188                              (snd $1, defSpec, fdec)
1189                            }
1190
1191 /* (* No return type and old-style parameter list *) */
1192 | IDENT LPAREN old_parameter_list_ne RPAREN old_pardef_list
1193                            { (* Convert pardecl to new style *)
1194                              let pardecl, isva = doOldParDecl $3 $5 in
1195                              (* Make the function declarator *)
1196                              let fdec = (fst $1,
1197                                          PROTO(JUSTBASE, pardecl,isva),
1198                                          [], snd $1) in
1199                              announceFunctionName fdec;
1200                              (* Default is int type *)
1201                              let defSpec = [SpecType Tint] in
1202                              (snd $1, defSpec, fdec)
1203                             }
1204 /* (* No return type and no parameters *) */
1205 | IDENT LPAREN                      RPAREN
1206                            { (* Make the function declarator *)
1207                              let fdec = (fst $1,
1208                                          PROTO(JUSTBASE, [], false),
1209                                          [], snd $1) in
1210                              announceFunctionName fdec;
1211                              (* Default is int type *)
1212                              let defSpec = [SpecType Tint] in
1213                              (snd $1, defSpec, fdec)
1214                             }
1215 ;
1216
1217 /* const/volatile as type specifier elements */
1218 cvspec:
1219     CONST                               { SpecCV(CV_CONST), $1 }
1220 |   VOLATILE                            { SpecCV(CV_VOLATILE), $1 }
1221 |   RESTRICT                            { SpecCV(CV_RESTRICT), $1 }
1222 ;
1223
1224 /*** GCC attributes ***/
1225 attributes:
1226     /* empty */                         { []}
1227 |   attribute attributes                { fst $1 :: $2 }
1228 ;
1229
1230 /* (* In some contexts we can have an inline assembly to specify the name to
1231     * be used for a global. We treat this as a name attribute *) */
1232 attributes_with_asm:
1233     /* empty */                         { [] }
1234 |   attribute attributes_with_asm       { fst $1 :: $2 }
1235 |   ASM LPAREN string_constant RPAREN attributes
1236                                         { ("__asm__",
1237                                            [CONSTANT(CONST_STRING (fst $3))]) :: $5 }
1238 ;
1239
1240 /* things like __attribute__, but no const/volatile */
1241 attribute_nocv:
1242     ATTRIBUTE LPAREN paren_attr_list RPAREN
1243                                         { ("__attribute__", $3), $1 }
1244 /*(*
1245 |   ATTRIBUTE_USED                      { ("__attribute__",
1246                                              [ VARIABLE "used" ]), $1 }
1247 *)*/
1248 |   DECLSPEC paren_attr_list_ne         { ("__declspec", $2), $1 }
1249 |   MSATTR                              { (fst $1, []), snd $1 }
1250                                         /* ISO 6.7.3 */
1251 |   THREAD                              { ("__thread",[]), $1 }
1252 ;
1253
1254 attribute_nocv_list:
1255     /* empty */                         { []}
1256 |   attribute_nocv attribute_nocv_list  { fst $1 :: $2 }
1257 ;
1258
1259 /* __attribute__ plus const/volatile */
1260 attribute:
1261     attribute_nocv                      { $1 }
1262 |   CONST                               { ("const", []), $1 }
1263 |   RESTRICT                            { ("restrict",[]), $1 }
1264 |   VOLATILE                            { ("volatile",[]), $1 }
1265 ;
1266
1267 /* (* sm: I need something that just includes __attribute__ and nothing more,
1268  *  to support them appearing between the 'struct' keyword and the type name.
1269  * Actually, a declspec can appear there as well (on MSVC) *)  */
1270 just_attribute:
1271     ATTRIBUTE LPAREN paren_attr_list RPAREN
1272                                         { ("__attribute__", $3) }
1273 |   DECLSPEC paren_attr_list_ne         { ("__declspec", $2) }
1274 ;
1275
1276 /* this can't be empty, b/c I folded that possibility into the calling
1277  * productions to avoid some S/R conflicts */
1278 just_attributes:
1279     just_attribute                      { [$1] }
1280 |   just_attribute just_attributes      { $1 :: $2 }
1281 ;
1282
1283 /** (* PRAGMAS and ATTRIBUTES *) ***/
1284 pragma:
1285 | PRAGMA_LINE                           { PRAGMA (fst $1, snd $1) }
1286 ;
1287
1288 /* (* We want to allow certain strange things that occur in pragmas, so we
1289     * cannot use directly the language of expressions *) */
1290 primary_attr:
1291     IDENT                               { VARIABLE (fst $1) }
1292     /*(* The NAMED_TYPE here creates conflicts with IDENT *)*/
1293 |   NAMED_TYPE                          { VARIABLE (fst $1) }
1294 |   LPAREN attr RPAREN                  { $2 }
1295 |   IDENT IDENT                          { CALL(VARIABLE (fst $1), [VARIABLE (fst $2)]) }
1296 |   CST_INT                              { CONSTANT(CONST_INT (fst $1)) }
1297 |   string_constant                      { CONSTANT(CONST_STRING (fst $1)) }
1298                                            /*(* Const when it appears in
1299                                             * attribute lists, is translated
1300                                             * to aconst *)*/
1301 |   CONST                                { VARIABLE "aconst" }
1302
1303 |   IDENT COLON CST_INT                  { VARIABLE (fst $1 ^ ":" ^ fst $3) }
1304
1305 /*(* The following rule conflicts with the ? : attributes. We give it a very
1306    * low priority *)*/
1307 |   CST_INT COLON CST_INT                { VARIABLE (fst $1 ^ ":" ^ fst $3) }
1308
1309 |   DEFAULT COLON CST_INT                { VARIABLE ("default:" ^ fst $3) }
1310
1311                                             /*(** GCC allows this as an
1312                                              * attribute for functions,
1313                                              * synonim for noreturn **)*/
1314 |   VOLATILE                             { VARIABLE ("__noreturn__") }
1315 ;
1316
1317 postfix_attr:
1318     primary_attr                         { $1 }
1319                                          /* (* use a VARIABLE "" so that the
1320                                              * parentheses are printed *) */
1321 |   IDENT LPAREN  RPAREN             { CALL(VARIABLE (fst $1), [VARIABLE ""]) }
1322 |   IDENT paren_attr_list_ne         { CALL(VARIABLE (fst $1), $2) }
1323
1324 |   postfix_attr ARROW id_or_typename    {MEMBEROFPTR ($1, $3)}
1325 |   postfix_attr DOT id_or_typename      {MEMBEROF ($1, $3)}
1326 |   postfix_attr LBRACKET attr RBRACKET  {INDEX ($1, $3) }
1327 ;
1328
1329 /*(* Since in attributes we use both IDENT and NAMED_TYPE as indentifiers,
1330  * that leads to conflicts for SIZEOF and ALIGNOF. In those cases we require
1331  * that their arguments be expressions, not attributes *)*/
1332 unary_attr:
1333     postfix_attr                         { $1 }
1334 |   SIZEOF unary_expression              {EXPR_SIZEOF (fst $2) }
1335 |   SIZEOF LPAREN type_name RPAREN
1336                                          {let b, d = $3 in TYPE_SIZEOF (b, d)}
1337
1338 |   ALIGNOF unary_expression             {EXPR_ALIGNOF (fst $2) }
1339 |   ALIGNOF LPAREN type_name RPAREN      {let b, d = $3 in TYPE_ALIGNOF (b, d)}
1340 |   PLUS cast_attr                      {UNARY (PLUS, $2)}
1341 |   MINUS cast_attr                     {UNARY (MINUS, $2)}
1342 |   STAR cast_attr                      {UNARY (MEMOF, $2)}
1343 |   AND cast_attr
1344                                         {UNARY (ADDROF, $2)}
1345 |   EXCLAM cast_attr                    {UNARY (NOT, $2)}
1346 |   TILDE cast_attr                     {UNARY (BNOT, $2)}
1347 ;
1348
1349 cast_attr:
1350     unary_attr                           { $1 }
1351 ;
1352
1353 multiplicative_attr:
1354     cast_attr                           { $1 }
1355 |   multiplicative_attr STAR cast_attr  {BINARY(MUL ,$1 , $3)}
1356 |   multiplicative_attr SLASH cast_attr   {BINARY(DIV ,$1 , $3)}
1357 |   multiplicative_attr PERCENT cast_attr {BINARY(MOD ,$1 , $3)}
1358 ;
1359
1360
1361 additive_attr:
1362     multiplicative_attr                 { $1 }
1363 |   additive_attr PLUS multiplicative_attr  {BINARY(ADD ,$1 , $3)}
1364 |   additive_attr MINUS multiplicative_attr {BINARY(SUB ,$1 , $3)}
1365 ;
1366
1367 shift_attr:
1368     additive_attr                       { $1 }
1369 |   shift_attr INF_INF additive_attr    {BINARY(SHL ,$1 , $3)}
1370 |   shift_attr SUP_SUP additive_attr    {BINARY(SHR ,$1 , $3)}
1371 ;
1372
1373 relational_attr:
1374     shift_attr                          { $1 }
1375 |   relational_attr INF shift_attr      {BINARY(LT ,$1 , $3)}
1376 |   relational_attr SUP shift_attr      {BINARY(GT ,$1 , $3)}
1377 |   relational_attr INF_EQ shift_attr   {BINARY(LE ,$1 , $3)}
1378 |   relational_attr SUP_EQ shift_attr   {BINARY(GE ,$1 , $3)}
1379 ;
1380
1381 equality_attr:
1382     relational_attr                     { $1 }
1383 |   equality_attr EQ_EQ relational_attr     {BINARY(EQ ,$1 , $3)}
1384 |   equality_attr EXCLAM_EQ relational_attr {BINARY(NE ,$1 , $3)}
1385 ;
1386
1387
1388 bitwise_and_attr:
1389     equality_attr                       { $1 }
1390 |   bitwise_and_attr AND equality_attr  {BINARY(BAND ,$1 , $3)}
1391 ;
1392
1393 bitwise_xor_attr:
1394     bitwise_and_attr                       { $1 }
1395 |   bitwise_xor_attr CIRC bitwise_and_attr {BINARY(XOR ,$1 , $3)}
1396 ;
1397
1398 bitwise_or_attr:
1399     bitwise_xor_attr                      { $1 }
1400 |   bitwise_or_attr PIPE bitwise_xor_attr {BINARY(BOR ,$1 , $3)}
1401 ;
1402
1403 logical_and_attr:
1404     bitwise_or_attr                             { $1 }
1405 |   logical_and_attr AND_AND bitwise_or_attr    {BINARY(AND ,$1 , $3)}
1406 ;
1407
1408 logical_or_attr:
1409     logical_and_attr                           { $1 }
1410 |   logical_or_attr PIPE_PIPE logical_and_attr {BINARY(OR ,$1 , $3)}
1411 ;
1412
1413 conditional_attr:
1414     logical_or_attr                        { $1 }
1415 /* This is in conflict for now */
1416 |   logical_or_attr QUEST conditional_attr COLON conditional_attr
1417                                           { QUESTION($1, $3, $5) }
1418
1419
1420 attr: conditional_attr                    { $1 }
1421 ;
1422
1423 attr_list_ne:
1424 |  attr                                  { [$1] }
1425 |  attr COMMA attr_list_ne               { $1 :: $3 }
1426 |  error COMMA attr_list_ne              { $3 }
1427 ;
1428 attr_list:
1429   /* empty */                            { [] }
1430 | attr_list_ne                           { $1 }
1431 ;
1432 paren_attr_list_ne:
1433    LPAREN attr_list_ne RPAREN            { $2 }
1434 |  LPAREN error RPAREN                   { [] }
1435 ;
1436 paren_attr_list:
1437    LPAREN attr_list RPAREN               { $2 }
1438 |  LPAREN error RPAREN                   { [] }
1439 ;
1440 /*** GCC ASM instructions ***/
1441 asmattr:
1442      /* empty */                        { [] }
1443 |    VOLATILE  asmattr                  { ("volatile", []) :: $2 }
1444 |    CONST asmattr                      { ("const", []) :: $2 }
1445 ;
1446 asmtemplate:
1447     one_string_constant                          { [$1] }
1448 |   one_string_constant asmtemplate              { $1 :: $2 }
1449 ;
1450 asmoutputs:
1451   /* empty */           { None }
1452 | COLON asmoperands asminputs
1453                         { let (ins, clobs) = $3 in
1454                           Some {aoutputs = $2; ainputs = ins; aclobbers = clobs} }
1455 ;
1456 asmoperands:
1457      /* empty */                        { [] }
1458 |    asmoperandsne                      { List.rev $1 }
1459 ;
1460 asmoperandsne:
1461      asmoperand                         { [$1] }
1462 |    asmoperandsne COMMA asmoperand     { $3 :: $1 }
1463 ;
1464 asmoperand:
1465      asmopname string_constant LPAREN expression RPAREN    { ($1, fst $2, fst $4) }
1466 |    asmopname string_constant LPAREN error RPAREN         { ($1, fst $2, NOTHING ) }
1467 ;
1468 asminputs:
1469   /* empty */                { ([], []) }
1470 | COLON asmoperands asmclobber
1471                         { ($2, $3) }
1472 ;
1473 asmopname:
1474     /* empty */                         { None }
1475 |   LBRACKET IDENT RBRACKET             { Some (fst $2) }
1476 ;
1477
1478 asmclobber:
1479     /* empty */                         { [] }
1480 | COLON asmcloberlst_ne                 { $2 }
1481 ;
1482 asmcloberlst_ne:
1483    one_string_constant                           { [$1] }
1484 |  one_string_constant COMMA asmcloberlst_ne     { $1 :: $3 }
1485 ;
1486
1487 %%
1488
1489
1490