parsing_c/parser_c.mly

   1 %{
   2 (* Copyright (C) 2002-2008 Yoann Padioleau
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License (GPL)
   6  * version 2 as published by the Free Software Foundation.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * file license.txt for more details.
  12  *)
  13 open Common
  14
  15 open Ast_c
  16
  17 module LP = Lexer_parser
  18 open Lexer_parser (* for the fields *)
  19
  20 open Semantic_c (* Semantic exn *)
  21
  22
  23 (*****************************************************************************)
  24 (* Wrappers *)
  25 (*****************************************************************************)
  26 let warning s v =
  27   if !Flag_parsing_c.verbose_parsing
  28   then Common.warning ("PARSING: " ^ s) v
  29   else v
  30
  31
  32 let pr2 s =
  33   if !Flag_parsing_c.verbose_parsing
  34   then Common.pr2 s
  35
  36 (*****************************************************************************)
  37 (* Parse helpers functions *)
  38 (*****************************************************************************)
  39
  40 (*-------------------------------------------------------------------------- *)
  41 (* Type related *)
  42 (*-------------------------------------------------------------------------- *)
  43
  44 type shortLong      = Short  | Long | LongLong
  45
  46 type decl = {
  47   storageD: storagebis wrap;
  48   typeD: ((sign option) * (shortLong option) * (typeCbis option)) wrap;
  49   qualifD: typeQualifierbis wrap;
  50   inlineD: bool             wrap;
  51   (* note: have a full_info: parse_info list; to remember ordering
  52    * between storage, qualifier, type ? well this info is already in
  53    * the Ast_c.info, just have to sort them to get good order *)
  54 }
  55
  56 let nullDecl = {
  57   storageD = NoSto, [];
  58   typeD = (None, None, None), [];
  59   qualifD = nullQualif;
  60   inlineD = false, [];
  61 }
  62 let fake_pi = Common.fake_parse_info
  63
  64 let addStorageD  = function
  65   | ((x,ii), ({storageD = (NoSto,[])} as v)) -> { v with storageD = (x, [ii]) }
  66   | ((x,ii), ({storageD = (y, ii2)} as v)) ->
  67       if x = y then warning "duplicate storage classes" v
  68       else raise (Semantic ("multiple storage classes", fake_pi))
  69
  70 let addInlineD  = function
  71   | ((true,ii), ({inlineD = (false,[])} as v)) -> { v with inlineD=(true,[ii])}
  72   | ((true,ii), ({inlineD = (true, ii2)} as v)) -> warning "duplicate inline" v
  73   | _ -> raise Impossible
  74
  75
  76 let addTypeD     = function
  77   | ((Left3 Signed,ii)   ,({typeD = ((Some Signed,  b,c),ii2)} as v)) ->
  78       warning "duplicate 'signed'"   v
  79   | ((Left3 UnSigned,ii) ,({typeD = ((Some UnSigned,b,c),ii2)} as v)) ->
  80       warning "duplicate 'unsigned'" v
  81   | ((Left3 _,ii),        ({typeD = ((Some _,b,c),ii2)} as _v)) ->
  82       raise (Semantic ("both signed and unsigned specified", fake_pi))
  83   | ((Left3 x,ii),        ({typeD = ((None,b,c),ii2)} as v))   ->
  84       {v with typeD = (Some x,b,c),ii ++ ii2}
  85
  86   | ((Middle3 Short,ii),  ({typeD = ((a,Some Short,c),ii2)} as v)) ->
  87       warning "duplicate 'short'" v
  88
  89
  90   (* gccext: long long allowed *)
  91   | ((Middle3 Long,ii),   ({typeD = ((a,Some Long ,c),ii2)} as v)) ->
  92       { v with typeD = (a, Some LongLong, c),ii++ii2 }
  93   | ((Middle3 Long,ii),   ({typeD = ((a,Some LongLong ,c),ii2)} as v)) ->
  94       warning "triplicate 'long'" v
  95
  96   | ((Middle3 _,ii),      ({typeD = ((a,Some _,c),ii2)} as _v)) ->
  97       raise (Semantic ("both long and short specified", fake_pi))
  98   | ((Middle3 x,ii),      ({typeD = ((a,None,c),ii2)} as v))  ->
  99       {v with typeD = (a, Some x,c),ii++ii2}
 100
 101   | ((Right3 t,ii),       ({typeD = ((a,b,Some _),ii2)} as _v)) ->
 102       raise (Semantic ("two or more data types", fake_pi))
 103   | ((Right3 t,ii),       ({typeD = ((a,b,None),ii2)} as v))   ->
 104       {v with typeD = (a,b, Some t),ii++ii2}
 105
 106
 107 let addQualif = function
 108   | ({const=true},   ({const=true} as x)) ->   warning "duplicate 'const'" x
 109   | ({volatile=true},({volatile=true} as x))-> warning "duplicate 'volatile'" x
 110   | ({const=true},    v) -> {v with const=true}
 111   | ({volatile=true}, v) -> {v with volatile=true}
 112   | _ -> internal_error "there is no noconst or novolatile keyword"
 113
 114 let addQualifD ((qu,ii), ({qualifD = (v,ii2)} as x)) =
 115   { x with qualifD = (addQualif (qu, v),ii::ii2) }
 116
 117
 118 (*-------------------------------------------------------------------------- *)
 119 (* Declaration/Function related *)
 120 (*-------------------------------------------------------------------------- *)
 121
 122
 123 (* stdC: type section, basic integer types (and ritchie)
 124  * To understand the code, just look at the result (right part of the PM)
 125  * and go back.
 126  *)
 127 let (fixDeclSpecForDecl: decl -> (fullType * (storage wrap)))  = function
 128  {storageD = (st,iist);
 129   qualifD = (qu,iiq);
 130   typeD = (ty,iit);
 131   inlineD = (inline,iinl);
 132   } ->
 133   (
 134    ((qu, iiq),
 135    (match ty with
 136  | (None,None,None)       -> warning "type defaults to 'int'" (defaultInt, [])
 137  | (None, None, Some t)   -> (t, iit)
 138
 139  | (Some sign,   None, (None| Some (BaseType (IntType (Si (_,CInt))))))  ->
 140      BaseType(IntType (Si (sign, CInt))), iit
 141  | ((None|Some Signed),Some x,(None|Some(BaseType(IntType (Si (_,CInt)))))) ->
 142      BaseType(IntType (Si (Signed, [Short,CShort; Long, CLong; LongLong, CLongLong] +> List.assoc x))), iit
 143  | (Some UnSigned, Some x, (None| Some (BaseType (IntType (Si (_,CInt))))))->
 144      BaseType(IntType (Si (UnSigned, [Short,CShort; Long, CLong; LongLong, CLongLong] +> List.assoc x))), iit
 145  | (Some sign,   None, (Some (BaseType (IntType CChar))))   -> BaseType(IntType (Si (sign, CChar2))), iit
 146  | (None, Some Long,(Some(BaseType(FloatType CDouble))))    -> BaseType (FloatType (CLongDouble)), iit
 147
 148  | (Some _,_, Some _) ->
 149      (*mine*)
 150      raise (Semantic ("signed, unsigned valid only for char and int", fake_pi))
 151  | (_,Some _,(Some(BaseType(FloatType (CFloat|CLongDouble))))) ->
 152      raise (Semantic ("long or short specified with floatint type", fake_pi))
 153  | (_,Some Short,(Some(BaseType(FloatType CDouble)))) ->
 154      raise (Semantic ("the only valid combination is long double", fake_pi))
 155
 156  | (_, Some _, Some _) ->
 157      (* mine *)
 158      raise (Semantic ("long, short valid only for int or float", fake_pi))
 159
 160      (* if do short uint i, then gcc say parse error, strange ? it is
 161       * not a parse error, it is just that we dont allow with typedef
 162       * either short/long or signed/unsigned. In fact, with
 163       * parse_typedef_fix2 (with et() and dt()) now I say too parse
 164       * error so this code is executed only when do short struct
 165       * {....} and never with a typedef cos now we parse short uint i
 166       * as short ident ident => parse error (cos after first short i
 167       * pass in dt() mode) *)
 168    ))
 169      ,((st, inline),iist++iinl)
 170   )
 171
 172 let fixDeclSpecForParam = function ({storageD = (st,iist)} as r) ->
 173   let ((qu,ty) as v,_st) = fixDeclSpecForDecl r in
 174   match st with
 175   | (Sto Register) -> (v, true), iist
 176   | NoSto -> (v, false), iist
 177   | _ ->
 178       raise
 179         (Semantic ("storage class specified for parameter of function",
 180                   fake_pi))
 181
 182 let fixDeclSpecForFuncDef x =
 183   let (returnType,storage) = fixDeclSpecForDecl x in
 184   (match fst (unwrap storage) with
 185   | StoTypedef ->
 186       raise (Semantic ("function definition declared 'typedef'", fake_pi))
 187   | x -> (returnType, storage)
 188   )
 189
 190 (* parameter: (this is the context where we give parameter only when
 191  * in func DEFINITION not in funct DECLARATION) We must have a name.
 192  * This function ensure that we give only parameterTypeDecl with well
 193  * formed Classic constructor todo?: do we accept other declaration
 194  * in ? so I must add them to the compound of the deffunc. I dont
 195  * have to handle typedef pb here cos C forbid to do VF f { ... }
 196  * with VF a typedef of func cos here we dont see the name of the
 197  * argument (in the typedef)
 198  *)
 199 let (fixOldCDecl: fullType -> fullType) = fun ty ->
 200   match snd ty with
 201   | ((FunctionType (fullt, (params, (b, iib)))),iifunc) ->
 202
 203       (* stdC: If the prototype declaration declares a parameter for a
 204        * function that you are defining (it is part of a function
 205        * definition), then you must write a name within the declarator.
 206        * Otherwise, you can omit the name. *)
 207       (match params with
 208       | [((reg, None, ((_qua, (BaseType Void,_)))),_), _] ->
 209           ty
 210       | params ->
 211           (params +> List.iter (function
 212           | (((b, None, _),  ii1),ii2) ->
 213               (* if majuscule, then certainly macro-parameter *)
 214               pr2 ("SEMANTIC:parameter name omitted, but I continue");
 215           | _ -> ()
 216           );
 217            ty)
 218       )
 219         (* todo? can we declare prototype in the decl or structdef,
 220            ... => length <> but good kan meme *)
 221   | _ ->
 222       (* gcc say parse error but dont see why *)
 223       raise (Semantic ("seems this is not a function", fake_pi))
 224
 225
 226 let fixFunc = function
 227   | ((
 228       (s,iis),
 229       (nQ, (FunctionType (fullt, (params,bool)),iifunc)),
 230       (st,iist)
 231     ),
 232     (cp,iicp)) ->
 233       let iistart = Ast_c.fakeInfo () in
 234       assert (nQ =*= nullQualif);
 235       (match params with
 236       | [((reg, None, ((_qua, (BaseType Void,_)))),_), _] ->  ()
 237       | params ->
 238           params +> List.iter (function
 239           | (((bool, Some s, fullt), _), _) -> ()
 240           | _ -> ()
 241                 (* failwith "internal errror: fixOldCDecl not good" *)
 242           ));
 243       (* it must be nullQualif,cos parser construct only this*)
 244       (s, (fullt, (params, bool)), st, cp),
 245       ([iis]++iifunc++iicp++[iistart]++iist)
 246   | _ ->
 247       raise
 248         (Semantic
 249             ("you are trying to do a function definition but you dont give " ^
 250              "any parameter", fake_pi))
 251
 252
 253 (*-------------------------------------------------------------------------- *)
 254 (* parse_typedef_fix2 *)
 255 (*-------------------------------------------------------------------------- *)
 256
 257 let dt s () =
 258   if !Flag_parsing_c.debug_etdt then pr2 ("<" ^ s);
 259   LP.disable_typedef ()
 260
 261 let et s () =
 262   if !Flag_parsing_c.debug_etdt then pr2 (">" ^ s);
 263   LP.enable_typedef ()
 264
 265
 266 let fix_add_params_ident = function
 267   | ((s, (nQ, (FunctionType (fullt, (params, bool)),_)), st)) ->
 268
 269       (match params with
 270       | [((reg, None, ((_qua, (BaseType Void,_)))),_), _] ->  ()
 271       | params ->
 272         params +> List.iter (function
 273          | (((bool, Some s, fullt), _), _) ->
 274             LP.add_ident s
 275          | _ ->
 276              ()
 277              (* failwith "internal errror: fixOldCDecl not good" *)
 278       ))
 279   | _ -> ()
 280
 281 (*-------------------------------------------------------------------------- *)
 282 (* shortcuts *)
 283 (*-------------------------------------------------------------------------- *)
 284
 285 let mk_e e ii = ((e, Ast_c.noType()), ii)
 286
 287 %}
 288
 289 /*(*****************************************************************************)*/
 290
 291 /*
 292 (*
 293  * Some tokens are not even used in this file because they are filtered
 294  * in some intermediate phase. But they still must be declared because
 295  * ocamllex may generate them, or some intermediate phase may also
 296  * generate them (like some functions in parsing_hacks.ml)
 297  *)
 298 */
 299
 300 %token <Ast_c.info> TUnknown /*(* unrecognized token *)*/
 301
 302 /*(* coupling: Token_helpers.is_real_comment *)*/
 303 %token <Ast_c.info> TComment TCommentSpace TCommentNewline
 304
 305 /*(* cppext: extra tokens *)*/
 306
 307 %token <Ast_c.info> TDefine
 308 %token <(string * Ast_c.info)> TDefParamVariadic
 309 /*(* disappear after fix_tokens_define *)*/
 310 %token <Ast_c.info> TCppEscapedNewline
 311 /*(* appear    after fix_tokens_define *)*/
 312 %token <Ast_c.info> TOParDefine
 313 %token <(string * Ast_c.info)> TIdentDefine /*(* same *)*/
 314 %token <Ast_c.info>            TDefEOL      /*(* same *)*/
 315
 316 /*(* used only in lexer_c, then transformed in comment or splitted in tokens *)*/
 317 %token <(string * string * bool ref * Ast_c.info)> TInclude
 318 /*(* tokens coming from above, generated in parse_c from TInclude, etc *)*/
 319 %token <(Ast_c.info * bool ref)> TIncludeStart
 320 %token <(string * Ast_c.info)> TIncludeFilename
 321
 322
 323 /*(* coupling: Token_helpers.is_cpp_instruction *)*/
 324 %token <Ast_c.info>          TIfdef TIfdefelse TIfdefelif TEndif
 325 %token <(bool * Ast_c.info)> TIfdefBool TIfdefMisc TIfdefVersion
 326
 327
 328 %token <Ast_c.info> TCommentMisc
 329 %token <(Ast_c.cppcommentkind * Ast_c.info)> TCommentCpp
 330
 331 /*(* appear  after fix_tokens_cpp *)*/
 332
 333 %token <Ast_c.info>            TMacroStmt
 334 /*(* no need value for the moment *)*/
 335 %token <Ast_c.info>            TMacroString
 336 %token <(string * Ast_c.info)> TMacroDecl
 337 %token <Ast_c.info>            TMacroDeclConst
 338 %token <(string * Ast_c.info)> TMacroIterator
 339 /*(* %token <(string * Ast_c.info)> TMacroTop *)*/
 340 /*(* appear after parsing_hack *)*/
 341 %token <Ast_c.info> TCParEOL
 342
 343 %token <Ast_c.info> TAction
 344
 345
 346 /*(* the normal tokens *)*/
 347
 348 %token <string * Ast_c.info>                     TInt
 349 %token <(string * Ast_c.floatType) * Ast_c.info> TFloat
 350 %token <(string * Ast_c.isWchar) * Ast_c.info>   TChar
 351 %token <(string * Ast_c.isWchar) * Ast_c.info>   TString
 352
 353 %token <string * Ast_c.info> TIdent TypedefIdent
 354
 355
 356 /*
 357 (* Some tokens like TOPar and TCPar are used as synchronisation stuff,
 358  * in parsing_hack.ml. So if define special tokens like TOParDefine and
 359  * TCParEOL, then take care to also modify in Token_helpers
 360  *)
 361 */
 362
 363 %token <Ast_c.info> TOPar TCPar TOBrace TCBrace TOCro TCCro
 364 %token <Ast_c.info> TDot TComma TPtrOp
 365 %token <Ast_c.info> TInc TDec
 366 %token <Ast_c.assignOp * Ast_c.info> TAssign
 367 %token <Ast_c.info> TEq
 368 %token <Ast_c.info> TWhy  TTilde TBang
 369 %token <Ast_c.info> TEllipsis
 370 %token <Ast_c.info> TDotDot
 371
 372 %token <Ast_c.info> TPtVirg
 373 %token <Ast_c.info>
 374        TOrLog TAndLog TOr TXor TAnd  TEqEq TNotEq TInf TSup TInfEq TSupEq
 375        TShl TShr
 376        TPlus TMinus TMul TDiv TMod
 377
 378 %token <Ast_c.info>
 379        Tchar Tshort Tint Tdouble Tfloat Tlong Tunsigned Tsigned Tvoid
 380        Tauto Tregister Textern Tstatic
 381        Ttypedef
 382        Tconst Tvolatile
 383        Tstruct Tunion Tenum
 384        Tbreak Telse Tswitch Tcase Tcontinue Tfor Tdo Tif  Twhile Treturn
 385        Tgoto Tdefault
 386        Tsizeof
 387
 388 /*(* gccext: extra tokens *)*/
 389 %token <Ast_c.info> Tasm
 390 %token <Ast_c.info> Tattribute
 391 %token <Ast_c.info> Tinline
 392 %token <Ast_c.info> Ttypeof
 393
 394
 395 %token <Ast_c.info> EOF
 396
 397
 398 /* operator precedence */
 399 %nonassoc Tif
 400 %nonassoc Telse
 401
 402 %left TOrLog
 403 %left TAndLog
 404 %left TOr
 405 %left TXor
 406 %left TAnd
 407 %left TEqEq TNotEq
 408 %left TInf TSup TInfEq TSupEq
 409 %left TShl TShr
 410 %left TPlus TMinus
 411 %left TMul TDiv TMod
 412
 413 %start main celem statement expr type_name
 414 %type <Ast_c.program> main
 415 %type <Ast_c.toplevel> celem
 416
 417 %type <Ast_c.statement> statement
 418 %type <Ast_c.expression> expr
 419 %type <Ast_c.fullType> type_name
 420
 421 %%
 422 /*(*************************************************************************)*/
 423 /*
 424 (* TOC:
 425  * expression
 426  * statement
 427  * declaration, types, initializers, struct, enum
 428  * xxx_list, xxx_opt
 429  * cpp directives
 430  * celem (=~ main)
 431  *)
 432 */
 433 /*(*************************************************************************)*/
 434
 435 /*(* no more used; now that use error recovery *)*/
 436
 437 main:  translation_unit EOF     { $1 }
 438
 439 translation_unit:
 440  | external_declaration
 441      { !LP._lexer_hint.toplevel <- true;   [$1] }
 442  | translation_unit external_declaration
 443      { !LP._lexer_hint.toplevel <- true; $1 ++ [$2] }
 444
 445
 446
 447 /*(*************************************************************************)*/
 448 /*(* expr *)*/
 449 /*(*************************************************************************)*/
 450
 451 expr:
 452  | assign_expr             { $1 }
 453  | expr TComma assign_expr { mk_e (Sequence ($1,$3)) [$2] }
 454
 455 /*(* bugfix: in C grammar they put unary_expr, but in fact it must be
 456    * cast_expr, otherwise (int * ) xxx = &yy; is not allowed
 457    *)*/
 458 assign_expr:
 459  | cond_expr                     { $1 }
 460  | cast_expr TAssign assign_expr { mk_e(Assignment ($1,fst $2,$3)) [snd $2]}
 461  | cast_expr TEq     assign_expr { mk_e(Assignment ($1,SimpleAssign,$3)) [$2]}
 462
 463 /*(* gccext: allow optional then part hence gcc_opt_expr
 464    * bugfix: in C grammar they put TDotDot cond_expr, but in fact it must be
 465    * assign_expr, otherwise   pnp ? x : x = 0x388  is not allowed
 466    *)*/
 467 cond_expr:
 468  | arith_expr
 469      { $1 }
 470  | arith_expr TWhy gcc_opt_expr TDotDot assign_expr
 471      { mk_e (CondExpr ($1,$3,$5)) [$2;$4] }
 472
 473
 474 arith_expr:
 475  | cast_expr                     { $1 }
 476  | arith_expr TMul    arith_expr { mk_e(Binary ($1, Arith Mul,      $3)) [$2] }
 477  | arith_expr TDiv    arith_expr { mk_e(Binary ($1, Arith Div,      $3)) [$2] }
 478  | arith_expr TMod    arith_expr { mk_e(Binary ($1, Arith Mod,      $3)) [$2] }
 479  | arith_expr TPlus   arith_expr { mk_e(Binary ($1, Arith Plus,     $3)) [$2] }
 480  | arith_expr TMinus  arith_expr { mk_e(Binary ($1, Arith Minus,    $3)) [$2] }
 481  | arith_expr TShl    arith_expr { mk_e(Binary ($1, Arith DecLeft,  $3)) [$2] }
 482  | arith_expr TShr    arith_expr { mk_e(Binary ($1, Arith DecRight, $3)) [$2] }
 483  | arith_expr TInf    arith_expr { mk_e(Binary ($1, Logical Inf,    $3)) [$2] }
 484  | arith_expr TSup    arith_expr { mk_e(Binary ($1, Logical Sup,    $3)) [$2] }
 485  | arith_expr TInfEq  arith_expr { mk_e(Binary ($1, Logical InfEq,  $3)) [$2] }
 486  | arith_expr TSupEq  arith_expr { mk_e(Binary ($1, Logical SupEq,  $3)) [$2] }
 487  | arith_expr TEqEq   arith_expr { mk_e(Binary ($1, Logical Eq,     $3)) [$2] }
 488  | arith_expr TNotEq  arith_expr { mk_e(Binary ($1, Logical NotEq,  $3)) [$2] }
 489  | arith_expr TAnd    arith_expr { mk_e(Binary ($1, Arith And,      $3)) [$2] }
 490  | arith_expr TOr     arith_expr { mk_e(Binary ($1, Arith Or,       $3)) [$2] }
 491  | arith_expr TXor    arith_expr { mk_e(Binary ($1, Arith Xor,      $3)) [$2] }
 492  | arith_expr TAndLog arith_expr { mk_e(Binary ($1, Logical AndLog, $3)) [$2] }
 493  | arith_expr TOrLog  arith_expr { mk_e(Binary ($1, Logical OrLog,  $3)) [$2] }
 494
 495 cast_expr:
 496  | unary_expr                        { $1 }
 497  | topar2 type_name tcpar2 cast_expr { mk_e(Cast ($2, $4)) [$1;$3] }
 498
 499 unary_expr:
 500  | postfix_expr                    { $1 }
 501  | TInc unary_expr                 { mk_e(Infix ($2, Inc))    [$1] }
 502  | TDec unary_expr                 { mk_e(Infix ($2, Dec))    [$1] }
 503  | unary_op cast_expr              { mk_e(Unary ($2, fst $1)) [snd $1] }
 504  | Tsizeof unary_expr              { mk_e(SizeOfExpr ($2))    [$1] }
 505  | Tsizeof topar2 type_name tcpar2 { mk_e(SizeOfType ($3))    [$1;$2;$4] }
 506
 507 unary_op:
 508  | TAnd   { GetRef,     $1 }
 509  | TMul   { DeRef,      $1 }
 510  | TPlus  { UnPlus,     $1 }
 511  | TMinus { UnMinus,    $1 }
 512  | TTilde { Tilde,      $1 }
 513  | TBang  { Not,        $1 }
 514  /*(* gccext: have that a lot in old kernel to get address of local label.
 515     * cf gcc manual "local labels as values".
 516     *)*/
 517  | TAndLog { GetRefLabel, $1 }
 518
 519
 520
 521 postfix_expr:
 522  | primary_expr               { $1 }
 523  | postfix_expr TOCro expr TCCro
 524      { mk_e(ArrayAccess ($1, $3)) [$2;$4] }
 525  | postfix_expr TOPar argument_list_ne TCPar
 526      { mk_e(FunCall ($1, $3)) [$2;$4] }
 527  | postfix_expr TOPar  TCPar  { mk_e(FunCall ($1, [])) [$2;$3] }
 528  | postfix_expr TDot   ident  { mk_e(RecordAccess   ($1,fst $3)) [$2;snd $3] }
 529  | postfix_expr TPtrOp ident  { mk_e(RecordPtAccess ($1,fst $3)) [$2;snd $3] }
 530  | postfix_expr TInc          { mk_e(Postfix ($1, Inc)) [$2] }
 531  | postfix_expr TDec          { mk_e(Postfix ($1, Dec)) [$2] }
 532
 533  /*(* gccext: also called compound literals *)*/
 534  | topar2 type_name tcpar2 TOBrace TCBrace
 535      { mk_e(Constructor ($2, [])) [$1;$3;$4;$5] }
 536  | topar2 type_name tcpar2 TOBrace initialize_list gcc_comma_opt TCBrace
 537      { mk_e(Constructor ($2, List.rev $5)) ([$1;$3;$4;$7] ++ $6) }
 538
 539 primary_expr:
 540  | TIdent  { mk_e(Ident  (fst $1)) [snd $1] }
 541  | TInt    { mk_e(Constant (Int    (fst $1))) [snd $1] }
 542  | TFloat  { mk_e(Constant (Float  (fst $1))) [snd $1] }
 543  | TString { mk_e(Constant (String (fst $1))) [snd $1] }
 544  | TChar   { mk_e(Constant (Char   (fst $1))) [snd $1] }
 545  | TOPar expr TCPar { mk_e(ParenExpr ($2)) [$1;$3] }  /*(* forunparser: *)*/
 546
 547  /*(* gccext: cppext: *)*/
 548  | string_elem string_list { mk_e(Constant (MultiString)) ($1 ++ $2) }
 549
 550  /*(* gccext: allow statement as expressions via ({ statement }) *)*/
 551  | TOPar compound TCPar  { mk_e(StatementExpr ($2)) [$1;$3] }
 552
 553
 554
 555
 556 /*(* cppext: *)*/
 557 argument_ne:
 558  | assign_expr { Left $1 }
 559  | parameter_decl { Right (ArgType $1)  }
 560  | action_higherordermacro_ne { Right (ArgAction $1) }
 561
 562 argument:
 563  | assign_expr { Left $1 }
 564  | parameter_decl { Right (ArgType $1)  }
 565  | action_higherordermacro { Right (ArgAction $1) }
 566
 567 action_higherordermacro_ne:
 568  | taction_list_ne
 569      { if null $1
 570        then ActMisc [Ast_c.fakeInfo()]
 571        else ActMisc $1
 572      }
 573
 574 action_higherordermacro:
 575  | taction_list
 576      { if null $1
 577        then ActMisc [Ast_c.fakeInfo()]
 578        else ActMisc $1
 579      }
 580
 581
 582 /*(*----------------------------*)*/
 583 /*(* workarounds *)*/
 584 /*(*----------------------------*)*/
 585
 586 /*(* Why this ? Why not s/ident/TIdent ? cos there is multiple namespaces in C,
 587    * so a label can have the same name that a typedef, same for field and tags
 588    * hence sometimes the use of ident  instead of TIdent.
 589    *)*/
 590 ident:
 591  | TIdent       { $1 }
 592  | TypedefIdent { $1 }
 593
 594 identifier:
 595  | TIdent       { $1 }
 596
 597 /*(* would like evalInt $1 but require too much info *)*/
 598 const_expr: cond_expr { $1  }
 599
 600
 601 topar2: TOPar { et "topar2" (); $1  }
 602 tcpar2: TCPar { et "tcpar2" (); $1 (*TODO? et ? sure ? c pas dt plutot ? *) }
 603
 604
 605
 606 /*(*************************************************************************)*/
 607 /*(* statement *)*/
 608 /*(*************************************************************************)*/
 609
 610 statement:
 611  | labeled         { Labeled      (fst $1), snd $1 }
 612  | compound        { Compound     (fst $1), snd $1 }
 613  | expr_statement  { ExprStatement(fst $1), snd $1 }
 614  | selection       { Selection    (fst $1), snd $1 ++ [fakeInfo()] }
 615  | iteration       { Iteration    (fst $1), snd $1 ++ [fakeInfo()] }
 616  | jump TPtVirg    { Jump         (fst $1), snd $1 ++ [$2] }
 617
 618  /*(* gccext: *)*/
 619  | Tasm TOPar asmbody TCPar TPtVirg             { Asm $3, [$1;$2;$4;$5] }
 620  | Tasm Tvolatile TOPar asmbody TCPar TPtVirg   { Asm $4, [$1;$2;$3;$5;$6] }
 621
 622  /*(* cppext: *)*/
 623  | TMacroStmt { MacroStmt, [$1] }
 624  | TMacroStmt TPtVirg { MacroStmt, [$1;$2] }
 625
 626
 627
 628
 629 /*(* note that case 1: case 2: i++;    would be correctly parsed, but with
 630    * a Case  (1, (Case (2, i++)))  :(
 631    *)*/
 632 labeled:
 633  | ident            TDotDot statement   { Label (fst $1, $3),  [snd $1; $2] }
 634  | Tcase const_expr TDotDot statement   { Case ($2, $4),       [$1; $3] }
 635  | Tcase const_expr TEllipsis const_expr TDotDot statement
 636      { CaseRange ($2, $4, $6), [$1;$3;$5] } /*(* gccext: allow range *)*/
 637  | Tdefault         TDotDot statement   { Default $3,             [$1; $2] }
 638
 639 end_labeled:
 640  /*(* gccext:  allow toto: }
 641     * generate each 30 shift/Reduce conflicts,  mais ca va, ca fait ce qu'il
 642     * faut
 643     *)*/
 644  | ident            TDotDot
 645      { Label (fst $1, (ExprStatement None, [])), [snd $1; $2] }
 646  | Tcase const_expr TDotDot { Case ($2, (ExprStatement None, [])), [$1;$3] }
 647  | Tdefault         TDotDot { Default (ExprStatement None, []),    [$1; $2] }
 648
 649
 650
 651
 652
 653 compound: tobrace compound2 tcbrace { $2, [$1; $3]  }
 654
 655 tobrace:  TOBrace                    {  LP.new_scope (); $1 }
 656 tcbrace:  TCBrace                    {  LP.del_scope (); $1 }
 657
 658 /*(* old:
 659 compound2:
 660  |                            { ([],[]) }
 661  |  statement_list            { ([], $1) }
 662  |  decl_list                 { ($1, []) }
 663  |  decl_list statement_list  { ($1,$2) }
 664
 665 statement_list: stat_or_decl_list { $1 }
 666 *)*/
 667
 668
 669 /*
 670 (* cppext: because of cpp, some stuff looks like declaration but are in
 671  * fact statement but too hard to figure out, and if parse them as
 672  * expression, then we force to have first decls and then exprs, then
 673  * will have a parse error. So easier to let mix decl/statement.
 674  * Moreover it helps to not make such a difference between decl and
 675  * statement for further coccinelle phases to factorize code.
 676 *)*/
 677 compound2:
 678  |                   { ([]) }
 679  | stat_or_decl_list { $1 }
 680
 681 stat_or_decl:
 682  | decl      { Decl ($1 Ast_c.LocalDecl), [] }
 683  | statement { $1 }
 684
 685   /*(* cppext: if -ifdef_to_if is enabled for parsing_hack *)*/
 686  | TIfdef stat_or_decl_list TIfdefelse stat_or_decl_list TEndif
 687      { Selection (Ifdef ($2, $4)), [$1;$3;$5;fakeInfo()] }
 688  | TIfdef stat_or_decl_list TEndif
 689      { Selection (Ifdef ($2, [])), [$1;$3;fakeInfo()] }
 690
 691   /*(* gccext: *)*/
 692  | function_definition { NestedFunc $1, [] }
 693
 694
 695
 696
 697
 698
 699 expr_statement:
 700  | TPtVirg      { None,    [$1] }
 701  | expr TPtVirg { Some $1, [$2] }
 702
 703 selection:
 704  | Tif TOPar expr TCPar statement %prec Tif
 705      { If ($3, $5, (ExprStatement None, [])),   [$1;$2;$4] }
 706  | Tif TOPar expr TCPar statement Telse statement
 707      { If ($3, $5, $7),  [$1;$2;$4;$6] }
 708  | Tswitch TOPar expr TCPar statement
 709      { Switch ($3,$5),   [$1;$2;$4]  }
 710
 711 iteration:
 712  | Twhile TOPar expr TCPar statement
 713      { While ($3,$5),                [$1;$2;$4] }
 714  | Tdo statement Twhile TOPar expr TCPar TPtVirg
 715      { DoWhile ($2,$5),              [$1;$3;$4;$6;$7] }
 716  | Tfor TOPar expr_statement expr_statement TCPar statement
 717      { For ($3,$4,(None, []),$6),    [$1;$2;$5]}
 718  | Tfor TOPar expr_statement expr_statement expr TCPar statement
 719      { For ($3,$4,(Some $5, []),$7), [$1;$2;$6] }
 720 /*(* c++ext: for(int i = 0; i < n; i++)
 721  | Tfor TOPar decl expr_statement expr TCPar statement
 722      { pr2 "DECL in for";
 723        While ($5, $7), [] (* fake ast *)
 724      }
 725 *)*/
 726  /*(* cppext: *)*/
 727  | TMacroIterator TOPar argument_list_ne TCPar statement
 728      { MacroIteration (fst $1, $3, $5), [snd $1;$2;$4] }
 729  | TMacroIterator TOPar TCPar statement
 730      { MacroIteration (fst $1, [], $4), [snd $1;$2;$3] }
 731
 732 /*(* the ';' in the caller grammar rule will be appended to the infos *)*/
 733 jump:
 734  | Tgoto ident  { Goto (fst $2),  [$1;snd $2] }
 735  | Tcontinue    { Continue,       [$1] }
 736  | Tbreak       { Break,          [$1] }
 737  | Treturn      { Return,         [$1] }
 738  | Treturn expr { ReturnExpr $2,  [$1] }
 739  | Tgoto TMul expr { GotoComputed $3, [$1;$2] }
 740
 741
 742
 743 /*(*----------------------------*)*/
 744 /*(* gccext: *)*/
 745 /*(*----------------------------*)*/
 746 string_elem:
 747  | TString { [snd $1] }
 748  /*(* cppext:  ex= printk (KERN_INFO "xxx" UTS_RELEASE)  *)*/
 749  | TMacroString { [$1] }
 750
 751
 752 asmbody:
 753  | string_list colon_asm_list  { $1, $2 }
 754  | string_list { $1, [] } /*(* in old kernel *)*/
 755
 756
 757 colon_asm: TDotDot colon_option_list { Colon $2, [$1]   }
 758
 759 colon_option:
 760  | TString                      { ColonMisc, [snd $1] }
 761  | TString TOPar asm_expr TCPar { ColonExpr $3, [snd $1; $2;$4] }
 762  /*(* cppext: certainly a macro *)*/
 763  | TOCro identifier TCCro TString TOPar asm_expr TCPar
 764      { ColonExpr $6, [$1;snd $2;$3;snd $4; $5; $7 ] }
 765  | identifier                       { ColonMisc, [snd $1] }
 766  | /*(* empty *)*/                  { ColonMisc, [] }
 767
 768 asm_expr: assign_expr { $1 }
 769
 770
 771
 772 /*(*************************************************************************)*/
 773 /*(* declaration, types, initializers *)*/
 774 /*(*************************************************************************)*/
 775
 776 decl2:
 777  | decl_spec TPtVirg
 778      { function local ->
 779        let (returnType,storage) = fixDeclSpecForDecl $1 in
 780        let iistart = Ast_c.fakeInfo () in
 781        DeclList ([(None, returnType, unwrap storage, local),[]],
 782                 ($2::iistart::snd storage))
 783      }
 784  | decl_spec init_declarator_list TPtVirg
 785      { function local ->
 786        let (returnType,storage) = fixDeclSpecForDecl $1 in
 787        let iistart = Ast_c.fakeInfo () in
 788        DeclList (
 789          ($2 +> List.map (fun ((((s,iis),f), ini), iivirg) ->
 790            let ini, iini =
 791              match ini with
 792              | None -> None, []
 793              | Some (ini, iini) -> Some ini, [iini]
 794            in
 795            if fst (unwrap storage) = StoTypedef
 796            then LP.add_typedef s;
 797            (Some ((s, ini), iis::iini), f returnType, unwrap storage, local),
 798            iivirg
 799          )
 800          ),  ($3::iistart::snd storage))
 801      }
 802  /*(* cppext: *)*/
 803
 804  | TMacroDecl TOPar argument_list TCPar TPtVirg
 805      { function _ ->
 806        MacroDecl ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]) }
 807  | Tstatic TMacroDecl TOPar argument_list TCPar TPtVirg
 808      { function _ ->
 809        MacroDecl ((fst $2, $4), [snd $2;$3;$5;$6;fakeInfo();$1]) }
 810  | Tstatic TMacroDeclConst TMacroDecl TOPar argument_list TCPar TPtVirg
 811      { function _ ->
 812        MacroDecl ((fst $3, $5), [snd $3;$4;$6;$7;fakeInfo();$1;$2])}
 813
 814
 815
 816 decl_spec2:
 817  | storage_class_spec      { {nullDecl with storageD = (fst $1, [snd $1]) } }
 818  | type_spec               { addTypeD ($1,nullDecl) }
 819  | type_qualif             { {nullDecl with qualifD  = (fst $1, [snd $1]) } }
 820  | Tinline                 { {nullDecl with inlineD = (true, [$1]) } }
 821  | storage_class_spec decl_spec2 { addStorageD ($1, $2) }
 822  | type_spec          decl_spec2 { addTypeD    ($1, $2) }
 823  | type_qualif        decl_spec2 { addQualifD  ($1, $2) }
 824  | Tinline            decl_spec2 { addInlineD ((true, $1), $2) }
 825
 826 /*(* can simplify by putting all in _opt ? must have at least one otherwise
 827    *  decl_list is ambiguous ? (no cos have ';' between decl)
 828    *)*/
 829
 830
 831 storage_class_spec:
 832  | Tstatic      { Sto Static,  $1 }
 833  | Textern      { Sto Extern,  $1 }
 834  | Tauto        { Sto Auto,    $1 }
 835  | Tregister    { Sto Register,$1 }
 836  | Ttypedef     { StoTypedef,  $1 }
 837
 838 type_spec2:
 839  | Tvoid                { Right3 (BaseType Void),            [$1] }
 840  | Tchar                { Right3 (BaseType (IntType CChar)), [$1]}
 841  | Tint                 { Right3 (BaseType (IntType (Si (Signed,CInt)))), [$1]}
 842  | Tfloat               { Right3 (BaseType (FloatType CFloat)),  [$1]}
 843  | Tdouble              { Right3 (BaseType (FloatType CDouble)), [$1] }
 844  | Tshort               { Middle3 Short,  [$1]}
 845  | Tlong                { Middle3 Long,   [$1]}
 846  | Tsigned              { Left3 Signed,   [$1]}
 847  | Tunsigned            { Left3 UnSigned, [$1]}
 848  | struct_or_union_spec { Right3 (fst $1), snd $1 }
 849  | enum_spec            { Right3 (fst $1), snd $1 }
 850
 851  /*
 852  (* parse_typedef_fix1: cant put: TIdent {} cos it make the grammar
 853   * ambiguous, generates lots of conflicts => we must
 854   * use some tricks: we make the lexer and parser cooperate, cf lexerParser.ml.
 855   *
 856   * parse_typedef_fix2: this is not enough, and you must use
 857   * parse_typedef_fix2 to fully manage typedef problems in grammar.
 858   *
 859   * parse_typedef_fix3:
 860   *
 861   * parse_typedef_fix4: try also to do now some consistency checking in
 862   * Parse_c
 863   *)*/
 864  | TypedefIdent   { Right3 (TypeName (fst $1,Ast_c.noTypedefDef())), [snd $1]}
 865
 866  | Ttypeof TOPar assign_expr TCPar { Right3 (TypeOfExpr ($3)), [$1;$2;$4] }
 867  | Ttypeof TOPar type_name   TCPar { Right3 (TypeOfType ($3)), [$1;$2;$4] }
 868
 869
 870 type_qualif:
 871  | Tconst    { {const=true  ; volatile=false}, $1 }
 872  | Tvolatile { {const=false ; volatile=true},  $1 }
 873
 874
 875
 876 /*(*----------------------------*)*/
 877 /*(* workarounds *)*/
 878 /*(*----------------------------*)*/
 879
 880 decl:      decl2         { et "decl" (); $1 }
 881 decl_spec: decl_spec2    { dt "declspec" (); $1  }
 882 type_spec: type_spec2    { dt "type" (); $1   }
 883
 884
 885
 886
 887
 888
 889 /*(*-----------------------------------------------------------------------*)*/
 890 /*(* for struct and also typename *)*/
 891 /*(* cant put decl_spec cos no storage is allowed for field struct *)*/
 892 spec_qualif_list2:
 893  | type_spec                    { addTypeD ($1, nullDecl) }
 894  | type_qualif                  { {nullDecl with qualifD = (fst $1,[snd $1])}}
 895  | type_spec   spec_qualif_list { addTypeD ($1,$2)   }
 896  | type_qualif spec_qualif_list { addQualifD ($1,$2) }
 897
 898 spec_qualif_list: spec_qualif_list2            {  dt "spec_qualif" (); $1 }
 899
 900 /*(*-----------------------------------------------------------------------*)*/
 901 init_declarator: init_declarator2  { dt "init" (); $1 }
 902
 903 init_declarator2:
 904  | declaratori                  { ($1, None) }
 905  | declaratori teq initialize   { ($1, Some ($3, $2)) }
 906
 907
 908
 909 /*(*----------------------------*)*/
 910 /*(* workarounds *)*/
 911 /*(*----------------------------*)*/
 912 declaratori:
 913  | declarator
 914      { LP.add_ident (fst (fst $1)); $1 }
 915  /*(* gccext: *)*/
 916  | declarator gcc_asm_decl
 917      { LP.add_ident (fst (fst $1)); $1 }
 918
 919 teq: TEq  { et "teq" (); $1 }
 920
 921
 922
 923 /*(*----------------------------*)*/
 924 /*(* gccext: *)*/
 925 /*(*----------------------------*)*/
 926
 927 gcc_asm_decl:
 928  | Tasm TOPar asmbody TCPar              {  }
 929  | Tasm Tvolatile TOPar asmbody TCPar   {  }
 930
 931
 932
 933
 934
 935 /*(*-----------------------------------------------------------------------*)*/
 936
 937 /*
 938 (* declarator return a couple:
 939  *  (name, partial type (a function to be applied to return type))
 940  *
 941  * when int* f(int) we must return Func(Pointer int,int) and not
 942  * Pointer (Func(int,int)
 943  *)*/
 944
 945 declarator:
 946  | pointer direct_d { (fst $2, fun x -> x +> $1 +> (snd $2)  ) }
 947  | direct_d         { $1  }
 948
 949 /*(* so must do  int * const p; if the pointer is constant, not the pointee *)*/
 950 pointer:
 951  | TMul                          { fun x ->(nQ,         (Pointer x,     [$1]))}
 952  | TMul type_qualif_list         { fun x ->($2.qualifD, (Pointer x,     [$1]))}
 953  | TMul pointer                  { fun x ->(nQ,         (Pointer ($2 x),[$1]))}
 954  | TMul type_qualif_list pointer { fun x ->($2.qualifD, (Pointer ($3 x),[$1]))}
 955
 956 type_qualif_list:
 957  | type_qualif                  { {nullDecl with qualifD = (fst $1,[snd $1])} }
 958  | type_qualif_list type_qualif { addQualifD ($2,$1) }
 959
 960 direct_d:
 961  | identifier
 962      { ($1, fun x -> x) }
 963  | TOPar declarator TCPar      /*(* forunparser: old: $2 *)*/
 964      { (fst $2, fun x -> (nQ, (ParenType ((snd $2) x), [$1;$3]))) }
 965  | direct_d tocro            tccro
 966      { (fst $1,fun x->(snd $1) (nQ,(Array (None,x),         [$2;$3]))) }
 967  | direct_d tocro const_expr tccro
 968      { (fst $1,fun x->(snd $1) (nQ,(Array (Some $3,x),      [$2;$4])))}
 969  | direct_d topar            tcpar
 970      { (fst $1,
 971        fun x->(snd $1)
 972          (nQ,(FunctionType (x,(([],(false, [])))),[$2;$3])))
 973      }
 974  | direct_d topar parameter_type_list tcpar
 975      { (fst $1,fun x->(snd $1) (nQ,(FunctionType (x, $3),   [$2;$4]))) }
 976
 977
 978 parameter_type_list:
 979  | parameter_list                  { ($1, (false, []))}
 980  | parameter_list TComma TEllipsis { ($1, (true,  [$2;$3])) }
 981
 982
 983 parameter_decl2:
 984  | decl_spec declaratorp
 985      { let ((returnType,hasreg),iihasreg) = fixDeclSpecForParam $1
 986        in
 987        (hasreg, Some (fst (fst $2)), ((snd $2) returnType)),
 988         (iihasreg ++ [snd (fst $2)])
 989      }
 990  | decl_spec abstract_declarator
 991      { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1
 992        in (hasreg, None, ($2 returnType)),      (iihasreg ++ [])
 993      }
 994  | decl_spec
 995      { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1
 996        in (hasreg, None, returnType),           (iihasreg ++ [])
 997      }
 998
 999
1000 /*(*----------------------------*)*/
1001 /*(* workarounds *)*/
1002 /*(*----------------------------*)*/
1003
1004 tocro: TOCro { et "tocro" ();$1 }
1005 tccro: TCCro { dt "tccro" ();$1 }
1006
1007 topar: TOPar
1008      { LP.new_scope ();et "topar" ();
1009        !LP._lexer_hint.parameterDeclaration <- true; $1
1010      }
1011 tcpar: TCPar
1012      { LP.del_scope ();dt "tcpar" ();
1013        !LP._lexer_hint.parameterDeclaration <- false; $1
1014      }
1015
1016 parameter_decl: parameter_decl2 { et "param" ();  $1 }
1017
1018 declaratorp: declarator
1019      { LP.add_ident (fst (fst $1)); $1 }
1020
1021
1022 /*(*-----------------------------------------------------------------------*)*/
1023 type_name:
1024  | spec_qualif_list
1025      { let (returnType, _) = fixDeclSpecForDecl $1 in  returnType }
1026  | spec_qualif_list abstract_declarator
1027      { let (returnType, _) = fixDeclSpecForDecl $1 in $2 returnType }
1028
1029
1030 abstract_declarator:
1031  | pointer                            { $1 }
1032  |         direct_abstract_declarator { $1 }
1033  | pointer direct_abstract_declarator { fun x -> x +> $2 +> $1 }
1034
1035 direct_abstract_declarator:
1036  | TOPar abstract_declarator TCPar /*(* forunparser: old: $2 *)*/
1037      { (fun x -> (nQ, (ParenType ($2 x), [$1;$3]))) }
1038
1039  | TOCro            TCCro
1040      { fun x ->   (nQ, (Array (None, x),      [$1;$2]))}
1041  | TOCro const_expr TCCro
1042      { fun x ->   (nQ, (Array (Some $2, x),   [$1;$3]))}
1043  | direct_abstract_declarator TOCro            TCCro
1044      { fun x ->$1 (nQ, (Array (None, x),      [$2;$3])) }
1045  | direct_abstract_declarator TOCro const_expr TCCro
1046      { fun x ->$1 (nQ, (Array (Some $3,x),    [$2;$4])) }
1047  | TOPar TCPar
1048      { fun x ->   (nQ, (FunctionType (x, ([], (false,  []))),   [$1;$2])) }
1049  | TOPar parameter_type_list TCPar
1050      { fun x ->   (nQ, (FunctionType (x, $2),           [$1;$3]))}
1051  | direct_abstract_declarator TOPar TCPar
1052      { fun x ->$1 (nQ, (FunctionType (x, (([], (false, [])))),[$2;$3])) }
1053  | direct_abstract_declarator TOPar parameter_type_list TCPar
1054      { fun x -> $1 (nQ, (FunctionType (x, $3), [$2;$4])) }
1055
1056 /*(*-----------------------------------------------------------------------*)*/
1057 initialize:
1058  | assign_expr
1059      { InitExpr $1,                [] }
1060  | tobrace_ini initialize_list gcc_comma_opt_struct  TCBrace
1061      { InitList (List.rev $2),     [$1;$4]++$3 }
1062  | tobrace_ini TCBrace
1063      { InitList [],       [$1;$2] } /*(* gccext: *)*/
1064
1065
1066 /*
1067 (* opti: This time we use the weird order of non-terminal which requires in
1068  * the "caller" to do a List.rev cos quite critical. With this wierd order it
1069  * allows yacc to use a constant stack space instead of exploding if we would
1070  * do a  'initialize2 Tcomma initialize_list'.
1071  *)
1072 */
1073 initialize_list:
1074  | initialize2                        { [$1,   []] }
1075  | initialize_list TComma initialize2 { ($3,  [$2])::$1 }
1076
1077
1078 /*(* gccext: condexpr and no assign_expr cos can have ambiguity with comma *)*/
1079 initialize2:
1080  | cond_expr
1081      { InitExpr $1,   [] }
1082  | tobrace_ini initialize_list gcc_comma_opt_struct TCBrace
1083      { InitList (List.rev $2),   [$1;$4]++$3 }
1084  | tobrace_ini TCBrace
1085      { InitList [],  [$1;$2]  }
1086
1087  /*(* gccext: labeled elements, a.k.a designators *)*/
1088  | designator_list TEq initialize2
1089      { InitDesignators ($1, $3), [$2] }
1090
1091  /*(* gccext: old format *)*/
1092  | ident TDotDot initialize2
1093      { InitFieldOld (fst $1, $3),     [snd $1; $2] } /*(* in old kernel *)*/
1094  | TOCro const_expr TCCro initialize2
1095      { InitIndexOld ($2, $4),    [$1;$3] }
1096
1097 /*(* they can be nested, can have a .x.[3].y *)*/
1098 designator:
1099  | TDot ident
1100      { DesignatorField (fst $2), [$1;snd $2] }
1101  | TOCro const_expr TCCro
1102      { DesignatorIndex ($2),  [$1;$3] }
1103  | TOCro const_expr TEllipsis const_expr TCCro
1104      { DesignatorRange ($2, $4),  [$1;$3;$5] }
1105
1106
1107 /*(*----------------------------*)*/
1108 /*(* workarounds *)*/
1109 /*(*----------------------------*)*/
1110
1111 gcc_comma_opt_struct:
1112  | TComma {  [$1] }
1113  | /*(* empty *)*/  {  [Ast_c.fakeInfo() +> Ast_c.rewrap_str ","]  }
1114
1115
1116 tobrace_ini: TOBrace { !LP._lexer_hint.toplevel <- false; $1 }
1117
1118
1119
1120
1121
1122
1123 /*(*-----------------------------------------------------------------------*)*/
1124 s_or_u_spec2:
1125  | struct_or_union ident tobrace_struct struct_decl_list_gcc tcbrace_struct
1126      { StructUnion (fst $1, Some (fst $2), $4),  [snd $1;snd $2;$3;$5]  }
1127  | struct_or_union       tobrace_struct struct_decl_list_gcc tcbrace_struct
1128      { StructUnion (fst $1, None, $3), [snd $1;$2;$4] }
1129  | struct_or_union ident
1130      { StructUnionName (fst $1, fst $2), [snd $1;snd $2] }
1131
1132 struct_or_union2:
1133  | Tstruct   { Struct, $1 }
1134  | Tunion    { Union, $1 }
1135
1136
1137
1138 struct_decl2:
1139  | spec_qualif_list struct_declarator_list TPtVirg
1140      {
1141        let (returnType,storage) = fixDeclSpecForDecl $1 in
1142        if fst (unwrap storage) <> NoSto
1143        then internal_error "parsing dont allow this";
1144
1145        FieldDeclList ($2 +> (List.map (fun (f, iivirg) ->
1146          f returnType, iivirg))
1147        ),    [$3]
1148          (* dont need to check if typedef or func initialised cos
1149           * grammar dont allow typedef nor initialiser in struct
1150           *)
1151      }
1152
1153
1154  |  spec_qualif_list TPtVirg
1155      {
1156        (* gccext: allow empty elements if it is a structdef or enumdef *)
1157        let (returnType,storage) = fixDeclSpecForDecl $1 in
1158        if fst (unwrap storage) <> NoSto
1159        then internal_error "parsing dont allow this";
1160
1161        FieldDeclList [(Simple (None, returnType), []) , []], [$2]
1162      }
1163  | TPtVirg { EmptyField, [$1]  }
1164
1165
1166
1167 struct_declarator:
1168  | declaratorsd
1169      { (fun x -> Simple   (Some (fst (fst $1)), (snd $1) x), [snd (fst $1)]) }
1170  | dotdot const_expr2
1171      { (fun x -> BitField (None, x, $2),              [$1]) }
1172  | declaratorsd dotdot const_expr2
1173      { (fun x -> BitField (Some (fst(fst $1)),
1174                           ((snd $1) x),
1175                           $3),
1176                           [snd (fst $1);$2])
1177      }
1178
1179
1180 /*(*----------------------------*)*/
1181 /*(* workarounds *)*/
1182 /*(*----------------------------*)*/
1183 tobrace_struct: TOBrace
1184      { !LP._lexer_hint.toplevel <- false;
1185        !LP._lexer_hint.structDefinition <- !LP._lexer_hint.structDefinition +1;
1186        $1
1187      }
1188 tcbrace_struct: TCBrace
1189      {
1190        !LP._lexer_hint.structDefinition <- !LP._lexer_hint.structDefinition -1;
1191        $1
1192      }
1193
1194 declaratorsd: declarator
1195   { (*also ? LP.add_ident (fst (fst $1)); *) $1 }
1196
1197
1198
1199 struct_or_union_spec: s_or_u_spec2 { dt "su" (); $1 }
1200 struct_or_union: struct_or_union2 { et "su" (); $1 }
1201 struct_decl: struct_decl2  { et "struct" (); $1 }
1202
1203 dotdot: TDotDot  { et "dotdot" (); $1 }
1204 const_expr2: const_expr { dt "const_expr2" (); $1 }
1205
1206 struct_decl_list_gcc:
1207  | struct_decl_list  { $1 }
1208  | /*(* empty *)*/       { [] } /*(* gccext: allow empty struct *)*/
1209
1210
1211 /*(*-----------------------------------------------------------------------*)*/
1212 enum_spec:
1213  | Tenum        tobrace_enum enumerator_list gcc_comma_opt TCBrace
1214      { Enum (None,    $3),           [$1;$2;$5] ++ $4 }
1215  | Tenum ident  tobrace_enum enumerator_list gcc_comma_opt TCBrace
1216      { Enum (Some (fst $2), $4),     [$1; snd $2; $3;$6] ++ $5 }
1217  | Tenum ident
1218      { EnumName (fst $2),       [$1; snd $2] }
1219
1220 enumerator:
1221  | idente                 { (fst $1, None),      [snd $1]    }
1222  | idente  TEq const_expr { (fst $1, Some $3),   [snd $1; $2] }
1223
1224
1225
1226 /*(*----------------------------*)*/
1227 /*(* workarounds *)*/
1228 /*(*----------------------------*)*/
1229
1230 idente: ident { LP.add_ident (fst $1); $1 }
1231
1232 tobrace_enum: TOBrace { !LP._lexer_hint.toplevel <- false; $1 }
1233
1234
1235
1236 /*(*************************************************************************)*/
1237 /*(* xxx_list, xxx_opt *)*/
1238 /*(*************************************************************************)*/
1239
1240
1241 /*(*
1242 decl_list:
1243  | decl           { [$1]   }
1244  | decl_list decl { $1 ++ [$2] }
1245
1246 statement_list:
1247  | statement { [$1] }
1248  | statement_list statement { $1 ++ [$2] }
1249 *)*/
1250
1251 stat_or_decl_list:
1252  | stat_or_decl { [$1] }
1253  | end_labeled  { [Labeled      (fst $1), snd $1] }
1254  | stat_or_decl stat_or_decl_list { $1 :: $2 }
1255
1256
1257
1258
1259 string_list:
1260  | string_elem { $1 }
1261  | string_list string_elem { $1 ++ $2 }
1262
1263 colon_asm_list:
1264  | colon_asm { [$1] }
1265  | colon_asm_list colon_asm  { $1 ++ [$2] }
1266
1267 colon_option_list:
1268  | colon_option { [$1, []] }
1269  | colon_option_list TComma colon_option { $1 ++ [$3, [$2]] }
1270
1271
1272
1273 argument_list_ne:
1274  | argument_ne                           { [$1, []] }
1275  | argument_list_ne TComma argument { $1 ++ [$3,    [$2]] }
1276
1277 argument_list:
1278  | argument                           { [$1, []] }
1279  | argument_list TComma argument { $1 ++ [$3,    [$2]] }
1280
1281 /*(*
1282 expression_list:
1283  | assign_expr { [$1, []] }
1284  | expression_list TComma assign_expr { $1 ++ [$3,   [$2]] }
1285 *)*/
1286
1287
1288 struct_decl_list:
1289  | struct_decl                   { [$1] }
1290  | struct_decl_list struct_decl  { $1 ++ [$2] }
1291
1292
1293 struct_declarator_list:
1294  | struct_declarator                               { [$1,           []] }
1295  | struct_declarator_list TComma struct_declarator { $1 ++ [$3,     [$2]] }
1296
1297
1298 enumerator_list:
1299  | enumerator                        { [$1,          []]   }
1300  | enumerator_list TComma enumerator { $1 ++ [$3,    [$2]] }
1301
1302
1303 init_declarator_list:
1304  | init_declarator                             { [$1,   []] }
1305  | init_declarator_list TComma init_declarator { $1 ++ [$3,     [$2]] }
1306
1307
1308 parameter_list:
1309  | parameter_decl                       { [$1, []] }
1310  | parameter_list TComma parameter_decl { $1 ++ [$3,  [$2]] }
1311
1312 taction_list_ne:
1313  | TAction                 { [$1] }
1314  | TAction taction_list_ne { $1 :: $2 }
1315
1316 taction_list:
1317  |                      { [] }
1318  | TAction taction_list { $1 :: $2 }
1319
1320 param_define_list:
1321  | /*(* empty *)*/ { [] }
1322  | param_define                           { [$1, []] }
1323  | param_define_list TComma param_define  { $1 ++ [$3, [$2]] }
1324
1325 designator_list:
1326  | designator { [$1] }
1327  | designator_list designator { $1 ++ [$2] }
1328
1329
1330 /*(* gccext:  which allow a trailing ',' in enum, as in perl *)*/
1331 gcc_comma_opt:
1332  | TComma {  [$1] }
1333  | /*(* empty *)*/  {  []  }
1334
1335 /*(*
1336 gcc_opt_virg:
1337  | TPtVirg { }
1338  |  { }
1339 *)*/
1340
1341 gcc_opt_expr:
1342  | expr        { Some $1 }
1343  | /*(* empty *)*/ { None  }
1344
1345 /*(*
1346 opt_ptvirg:
1347  | TPtVirg { [$1] }
1348  | { [] }
1349 *)*/
1350
1351
1352 /*(*************************************************************************)*/
1353 /*(* cpp directives *)*/
1354 /*(*************************************************************************)*/
1355
1356 /*(* cppext: *)*/
1357 cpp_directive:
1358
1359  | identifier TOPar argument_list TCPar TPtVirg
1360      { MacroTop (fst $1, $3,    [snd $1;$2;$4;$5]) }
1361
1362  /*(* TCParEOL to fix the end-of-stream bug of ocamlyacc *)*/
1363  | identifier TOPar argument_list TCParEOL
1364      { MacroTop (fst $1, $3,    [snd $1;$2;$4;fakeInfo()]) }
1365
1366   /*(* ex: EXPORT_NO_SYMBOLS; *)*/
1367  | identifier TPtVirg { EmptyDef [snd $1;$2] }
1368
1369  | TIncludeStart TIncludeFilename
1370      {
1371        let (i1, in_ifdef) = $1 in
1372        let (s, i2) = $2 in
1373
1374        (* redo some lexing work :( *)
1375        let inc_file =
1376          match () with
1377          | _ when s =~ "^\"\\(.*\\)\"$" ->
1378              Local (Common.split "/" (matched1 s))
1379          | _ when s =~ "^\\<\\(.*\\)\\>$" ->
1380              NonLocal (Common.split "/" (matched1 s))
1381          | _ ->
1382              Wierd s
1383        in
1384        Include ((inc_file, [i1;i2]), (Ast_c.noRelPos(), !in_ifdef))
1385      }
1386
1387  | TDefine TIdentDefine define_val TDefEOL
1388      { Define ((fst $2, [$1; snd $2;$4]), (DefineVar, $3)) }
1389
1390  /*
1391  (* The TOParDefine is introduced to avoid ambiguity with previous rules.
1392   * A TOParDefine is a TOPar that was just next to the ident.
1393   *)*/
1394  | TDefine TIdentDefine TOParDefine param_define_list TCPar define_val TDefEOL
1395      { Define
1396          ((fst $2, [$1; snd $2;$7]),
1397            (DefineFunc ($4, [$3;$5]), $6))
1398      }
1399
1400
1401 /*(* perhaps better to use assign_expr ? but in that case need
1402    * do a assign_expr_of_string in parse_c
1403    *)*/
1404 define_val:
1405  | expr      { DefineExpr $1 }
1406  | statement { DefineStmt $1 }
1407  | decl      { DefineStmt (Decl ($1 Ast_c.NotLocalDecl), []) }
1408  | TypedefIdent { DefineType (nQ,(TypeName(fst $1,noTypedefDef()),[snd $1]))}
1409  | function_definition { DefineFunction $1 }
1410
1411  | Tdo statement Twhile TOPar TInt TCPar
1412      {
1413        if fst $5 <> "0"
1414        then pr2 "WIERD: in macro and have not a while(0)";
1415        DefineDoWhileZero ($2,  [$1;$3;$4;snd $5;$6])
1416      }
1417  | /*(* empty *)*/ { DefineEmpty }
1418
1419 param_define:
1420  | identifier           { fst $1, [snd $1] }
1421  | TypedefIdent         { fst $1, [snd $1] }
1422  | TDefParamVariadic    { fst $1, [snd $1] }
1423  | TEllipsis            { "...", [$1] }
1424  /*(* they reuse keywords :(  *)*/
1425  | Tregister            { "register", [$1] }
1426
1427
1428 /*(*************************************************************************)*/
1429 /*(* celem *)*/
1430 /*(*************************************************************************)*/
1431
1432 external_declaration:
1433  | function_definition               { Definition $1 }
1434  | decl                              { Declaration ($1 Ast_c.NotLocalDecl) }
1435
1436 function_definition: function_def    { fixFunc $1 }
1437
1438 function_def: start_fun compound { LP.del_scope(); ($1, $2) }
1439
1440 start_fun: start_fun2
1441   { LP.new_scope();
1442     fix_add_params_ident $1;
1443     !LP._lexer_hint.toplevel <- false;
1444     $1
1445   }
1446
1447 start_fun2: decl_spec declaratorfd
1448      { let (returnType,storage) = fixDeclSpecForFuncDef $1 in
1449        (fst $2, fixOldCDecl ((snd $2) returnType) , storage)
1450      }
1451
1452 celem:
1453  | external_declaration                         { $1 }
1454  | cpp_directive                                { $1 }
1455
1456  /*(* can have asm declaration at toplevel *)*/
1457  | Tasm TOPar asmbody TCPar TPtVirg             { EmptyDef [] }
1458
1459  /*
1460  (* in ~/kernels/src/linux-2.5.2/drivers/isdn/hisax/isdnl3.c sometimes
1461   * the function ends with }; instead of just }
1462   * can also remove this rule and report "parse error" pb to morton
1463   *)*/
1464  | TPtVirg    { EmptyDef [$1] }
1465
1466
1467  | EOF        { FinalDef $1 }
1468
1469
1470 /*(*----------------------------*)*/
1471 /*(* workarounds *)*/
1472 /*(*----------------------------*)*/
1473 declaratorfd: declarator { et "declaratorfd" (); $1 }
1474
1475