parsing_c/parser_c.mly

   1 %{
   2 (* Yoann Padioleau
   3  *
   4  * Copyright (C) 2002, 2006, 2007, 2008, 2009 Yoann Padioleau
   5  *
   6  * This program is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU General Public License (GPL)
   8  * version 2 as published by the Free Software Foundation.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * file license.txt for more details.
  14  *)
  15 open Common
  16
  17 open Ast_c
  18
  19 module LP = Lexer_parser
  20 open Lexer_parser (* for the fields *)
  21
  22 open Semantic_c (* Semantic exn *)
  23
  24
  25 (*****************************************************************************)
  26 (* Wrappers *)
  27 (*****************************************************************************)
  28 let warning s v =
  29   if !Flag_parsing_c.verbose_parsing
  30   then Common.warning ("PARSING: " ^ s) v
  31   else v
  32
  33 let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing
  34
  35 (*****************************************************************************)
  36 (* Parse helpers functions *)
  37 (*****************************************************************************)
  38
  39 (*-------------------------------------------------------------------------- *)
  40 (* Type related *)
  41 (*-------------------------------------------------------------------------- *)
  42
  43 type shortLong      = Short  | Long | LongLong
  44
  45 type decl = {
  46   storageD: storagebis wrap;
  47   typeD: ((sign option) * (shortLong option) * (typeCbis option)) wrap;
  48   qualifD: typeQualifierbis wrap;
  49   inlineD: bool             wrap;
  50   (* note: have a full_info: parse_info list; to remember ordering
  51    * between storage, qualifier, type ? well this info is already in
  52    * the Ast_c.info, just have to sort them to get good order *)
  53 }
  54
  55 let nullDecl = {
  56   storageD = NoSto, [];
  57   typeD = (None, None, None), [];
  58   qualifD = nullQualif;
  59   inlineD = false, [];
  60 }
  61 let fake_pi = Common.fake_parse_info
  62
  63 let addStorageD  = function
  64   | ((x,ii), ({storageD = (NoSto,[])} as v)) -> { v with storageD = (x, [ii]) }
  65   | ((x,ii), ({storageD = (y, ii2)} as v)) ->
  66       if x =*= y then warning "duplicate storage classes" v
  67       else raise (Semantic ("multiple storage classes", fake_pi))
  68
  69 let addInlineD  = function
  70   | ((true,ii), ({inlineD = (false,[])} as v)) -> { v with inlineD=(true,[ii])}
  71   | ((true,ii), ({inlineD = (true, ii2)} as v)) -> warning "duplicate inline" v
  72   | _ -> raise Impossible
  73
  74
  75 let addTypeD     = function
  76   | ((Left3 Signed,ii)   ,({typeD = ((Some Signed,  b,c),ii2)} as v)) ->
  77       warning "duplicate 'signed'"   v
  78   | ((Left3 UnSigned,ii) ,({typeD = ((Some UnSigned,b,c),ii2)} as v)) ->
  79       warning "duplicate 'unsigned'" v
  80   | ((Left3 _,ii),        ({typeD = ((Some _,b,c),ii2)} as _v)) ->
  81       raise (Semantic ("both signed and unsigned specified", fake_pi))
  82   | ((Left3 x,ii),        ({typeD = ((None,b,c),ii2)} as v))   ->
  83       {v with typeD = (Some x,b,c),ii ++ ii2}
  84
  85   | ((Middle3 Short,ii),  ({typeD = ((a,Some Short,c),ii2)} as v)) ->
  86       warning "duplicate 'short'" v
  87
  88
  89   (* gccext: long long allowed *)
  90   | ((Middle3 Long,ii),   ({typeD = ((a,Some Long ,c),ii2)} as v)) ->
  91       { v with typeD = (a, Some LongLong, c),ii++ii2 }
  92   | ((Middle3 Long,ii),   ({typeD = ((a,Some LongLong ,c),ii2)} as v)) ->
  93       warning "triplicate 'long'" v
  94
  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   | _ ->
 113       internal_error "there is no noconst or novolatile keyword"
 114
 115 let addQualifD ((qu,ii), ({qualifD = (v,ii2)} as x)) =
 116   { x with qualifD = (addQualif (qu, v),ii::ii2) }
 117
 118
 119 (*-------------------------------------------------------------------------- *)
 120 (* Declaration/Function related *)
 121 (*-------------------------------------------------------------------------- *)
 122
 123
 124 (* stdC: type section, basic integer types (and ritchie)
 125  * To understand the code, just look at the result (right part of the PM)
 126  * and go back.
 127  *)
 128 let (fixDeclSpecForDecl: decl -> (fullType * (storage wrap)))  = function
 129  {storageD = (st,iist);
 130   qualifD = (qu,iiq);
 131   typeD = (ty,iit);
 132   inlineD = (inline,iinl);
 133   } ->
 134    let ty',iit' =
 135    (match ty with
 136  | (None,None,None)       ->
 137      (* generate fake_info, otherwise type_annotater can crash in
 138       * offset.
 139       *)
 140      warning "type defaults to 'int'" (defaultInt, [fakeInfo fake_pi])
 141  | (None, None, Some t)   -> (t, iit)
 142
 143  | (Some sign,   None, (None| Some (BaseType (IntType (Si (_,CInt))))))  ->
 144      BaseType(IntType (Si (sign, CInt))), iit
 145  | ((None|Some Signed),Some x,(None|Some(BaseType(IntType (Si (_,CInt)))))) ->
 146      BaseType(IntType (Si (Signed, [Short,CShort; Long, CLong; LongLong, CLongLong] +> List.assoc x))), iit
 147  | (Some UnSigned, Some x, (None| Some (BaseType (IntType (Si (_,CInt))))))->
 148      BaseType(IntType (Si (UnSigned, [Short,CShort; Long, CLong; LongLong, CLongLong] +> List.assoc x))), iit
 149  | (Some sign,   None, (Some (BaseType (IntType CChar))))   ->
 150      BaseType(IntType (Si (sign, CChar2))), iit
 151  | (None, Some Long,(Some(BaseType(FloatType CDouble))))    ->
 152      BaseType (FloatType (CLongDouble)), iit
 153
 154  | (Some _,_, Some _) ->
 155      (*mine*)
 156      raise (Semantic ("signed, unsigned valid only for char and int", fake_pi))
 157  | (_,Some _,(Some(BaseType(FloatType (CFloat|CLongDouble))))) ->
 158      raise (Semantic ("long or short specified with floatint type", fake_pi))
 159  | (_,Some Short,(Some(BaseType(FloatType CDouble)))) ->
 160      raise (Semantic ("the only valid combination is long double", fake_pi))
 161
 162  | (_, Some _, Some _) ->
 163      (* mine *)
 164      raise (Semantic ("long, short valid only for int or float", fake_pi))
 165
 166      (* if do short uint i, then gcc say parse error, strange ? it is
 167       * not a parse error, it is just that we dont allow with typedef
 168       * either short/long or signed/unsigned. In fact, with
 169       * parse_typedef_fix2 (with et() and dt()) now I say too parse
 170       * error so this code is executed only when do short struct
 171       * {....} and never with a typedef cos now we parse short uint i
 172       * as short ident ident => parse error (cos after first short i
 173       * pass in dt() mode) *)
 174
 175    )
 176    in
 177    ((qu, iiq),
 178    (ty', iit'))
 179      ,((st, inline),iist++iinl)
 180
 181
 182 let fixDeclSpecForParam = function ({storageD = (st,iist)} as r) ->
 183   let ((qu,ty) as v,_st) = fixDeclSpecForDecl r in
 184   match st with
 185   | (Sto Register) -> (v, true), iist
 186   | NoSto -> (v, false), iist
 187   | _ ->
 188       raise
 189         (Semantic ("storage class specified for parameter of function",
 190                   fake_pi))
 191
 192 let fixDeclSpecForMacro = function ({storageD = (st,iist)} as r) ->
 193   let ((qu,ty) as v,_st) = fixDeclSpecForDecl r in
 194   match st with
 195   | NoSto -> v
 196   | _ ->
 197       raise
 198         (Semantic ("storage class specified for macro type decl",
 199                   fake_pi))
 200
 201
 202 let fixDeclSpecForFuncDef x =
 203   let (returnType,storage) = fixDeclSpecForDecl x in
 204   (match fst (unwrap storage) with
 205   | StoTypedef ->
 206       raise (Semantic ("function definition declared 'typedef'", fake_pi))
 207   | _ -> (returnType, storage)
 208   )
 209
 210
 211 (* parameter: (this is the context where we give parameter only when
 212  * in func DEFINITION not in funct DECLARATION) We must have a name.
 213  * This function ensure that we give only parameterTypeDecl with well
 214  * formed Classic constructor todo?: do we accept other declaration
 215  * in ? so I must add them to the compound of the deffunc. I dont
 216  * have to handle typedef pb here cos C forbid to do VF f { ... }
 217  * with VF a typedef of func cos here we dont see the name of the
 218  * argument (in the typedef)
 219  *)
 220 let (fixOldCDecl: fullType -> fullType) = fun ty ->
 221   match Ast_c.unwrap_typeC ty with
 222   | FunctionType (fullt, (params, (b, iib))) ->
 223
 224       (* stdC: If the prototype declaration declares a parameter for a
 225        * function that you are defining (it is part of a function
 226        * definition), then you must write a name within the declarator.
 227        * Otherwise, you can omit the name. *)
 228       (match params with
 229       | [{p_namei = None; p_type = ty2},_] ->
 230           (match Ast_c.unwrap_typeC ty2 with
 231           | BaseType Void ->
 232               ty
 233           | _ ->
 234               pr2 ("SEMANTIC:parameter name omitted, but I continue");
 235               ty
 236           )
 237
 238       | params ->
 239           (params +> List.iter (fun (param,_) ->
 240             match param with
 241             | {p_namei = None} ->
 242               (* if majuscule, then certainly macro-parameter *)
 243                 pr2 ("SEMANTIC:parameter name omitted, but I continue");
 244             | _ -> ()
 245           ));
 246           ty
 247       )
 248
 249         (* todo? can we declare prototype in the decl or structdef,
 250            ... => length <> but good kan meme *)
 251   | _ ->
 252       (* gcc say parse error but dont see why *)
 253       raise (Semantic ("seems this is not a function", fake_pi))
 254
 255
 256 let fixFunc (typ, compound, old_style_opt) =
 257   let (cp,iicp) = compound in
 258
 259   let (name, ty,   (st,iist),  attrs) = typ in
 260
 261   let (qu, tybis) = ty in
 262
 263   match Ast_c.unwrap_typeC ty with
 264   | FunctionType (fullt, (params,abool)) ->
 265       let iifunc = Ast_c.get_ii_typeC_take_care tybis in
 266
 267       let iistart = Ast_c.fakeInfo () in
 268       assert (qu =*= nullQualif);
 269
 270       (match params with
 271       | [{p_namei= None; p_type = ty2}, _] ->
 272           (match Ast_c.unwrap_typeC ty2 with
 273           | BaseType Void ->  ()
 274           | _ ->
 275                 (* failwith "internal errror: fixOldCDecl not good" *)
 276               ()
 277           )
 278       | params ->
 279           params +> List.iter (function
 280           | ({p_namei = Some s}, _) -> ()
 281           | _ -> ()
 282                 (* failwith "internal errror: fixOldCDecl not good" *)
 283           )
 284       );
 285       (* bugfix: cf tests_c/function_pointer4.c.
 286        * Apparemment en C on peut syntaxiquement ecrire ca:
 287        *
 288        *   void a(int)(int x);
 289        * mais apres gcc gueule au niveau semantique avec:
 290        *   xxx.c:1: error: 'a' declared as function returning a function
 291        * Je ne faisais pas cette verif. Sur du code comme
 292        *   void METH(foo)(int x) { ...} , le parser croit (a tort) que foo
 293        * est un typedef, et donc c'est parsé comme l'exemple precedent,
 294        * ce qui ensuite confuse l'unparser qui n'est pas habitué
 295        * a avoir dans le returnType un FunctionType et qui donc
 296        * pr_elem les ii dans le mauvais sens ce qui genere au final
 297        * une exception. Hence this fix to at least detect the error
 298        * at parsing time (not unparsing time).
 299        *)
 300       (match Ast_c.unwrap_typeC fullt with
 301       | FunctionType _ ->
 302           let s = Ast_c.str_of_name name in
 303           let iis = Ast_c.info_of_name name in
 304           pr2 (spf "WEIRD: %s declared as function returning a function." s);
 305           pr2 (spf "This is probably because of a macro. Extend standard.h");
 306           raise (Semantic (spf "error: %s " s, Ast_c.parse_info_of_info iis))
 307       | _ -> ()
 308       );
 309
 310       (* it must be nullQualif,cos parser construct only this*)
 311       {f_name = name;
 312        f_type = (fullt, (params, abool));
 313        f_storage = st;
 314        f_body = cp;
 315        f_attr = attrs;
 316        f_old_c_style = old_style_opt;
 317       },
 318       (iifunc++iicp++[iistart]++iist)
 319   | _ ->
 320       raise
 321         (Semantic
 322             ("you are trying to do a function definition but you dont give " ^
 323              "any parameter", fake_pi))
 324
 325
 326 (*-------------------------------------------------------------------------- *)
 327 (* parse_typedef_fix2 *)
 328 (*-------------------------------------------------------------------------- *)
 329
 330 let dt s () =
 331   if !Flag_parsing_c.debug_etdt then pr2 ("<" ^ s);
 332   LP.disable_typedef ()
 333
 334 let et s () =
 335   if !Flag_parsing_c.debug_etdt then pr2 (">" ^ s);
 336   LP.enable_typedef ()
 337
 338
 339 let fix_add_params_ident x =
 340   let (s, ty, st, _attrs) = x in
 341   match Ast_c.unwrap_typeC ty with
 342   | FunctionType (fullt, (params, bool)) ->
 343
 344       (match params with
 345       | [{p_namei=None; p_type=ty2}, _] ->
 346           (match Ast_c.unwrap_typeC ty2 with
 347           | BaseType Void -> ()
 348           | _ ->
 349               (* failwith "internal errror: fixOldCDecl not good" *)
 350               ()
 351           )
 352       | params ->
 353           params +> List.iter (function
 354           | ({p_namei= Some name}, _) ->
 355               LP.add_ident (Ast_c.str_of_name s)
 356           | _ ->
 357               ()
 358                 (* failwith "internal errror: fixOldCDecl not good" *)
 359           )
 360       )
 361   | _ -> ()
 362
 363
 364
 365 (*-------------------------------------------------------------------------- *)
 366 (* shortcuts *)
 367 (*-------------------------------------------------------------------------- *)
 368
 369 let mk_e e ii = Ast_c.mk_e e ii
 370
 371 let mk_string_wrap (s,info) = (s, [info])
 372
 373 %}
 374
 375 /*(*****************************************************************************)*/
 376 /*(* Tokens *)*/
 377 /*(*************************************************************************)*/
 378
 379 /*
 380 (*
 381  * Some tokens are not even used in this file because they are filtered
 382  * in some intermediate phase. But they still must be declared because
 383  * ocamllex may generate them, or some intermediate phase may also
 384  * generate them (like some functions in parsing_hacks.ml)
 385  *)
 386 */
 387
 388 %token <Ast_c.info> TUnknown /*(* unrecognized token *)*/
 389
 390 /*(* coupling: Token_helpers.is_real_comment *)*/
 391 %token <Ast_c.info> TCommentSpace TCommentNewline   TComment
 392
 393 /*(*-----------------------------------------*)*/
 394 /*(* the normal tokens *)*/
 395 /*(*-----------------------------------------*)*/
 396
 397 %token <(string * (Ast_c.sign * Ast_c.base)) * Ast_c.info> TInt
 398 %token <(string * Ast_c.floatType) * Ast_c.info> TFloat
 399 %token <(string * Ast_c.isWchar) * Ast_c.info>   TChar
 400 %token <(string * Ast_c.isWchar) * Ast_c.info>   TString
 401
 402 %token <string * Ast_c.info> TIdent
 403 %token <string * Ast_c.info> Tconstructorname /* parsing_hack for c++ */
 404 /*(* appears mostly after some fix_xxx in parsing_hack *)*/
 405 %token <string * Ast_c.info> TypedefIdent
 406
 407
 408 /*
 409 (* Some tokens like TOPar and TCPar are used as synchronisation stuff,
 410  * in parsing_hack.ml. So if define special tokens like TOParDefine and
 411  * TCParEOL, then take care to also modify in Token_helpers.
 412  *)
 413 */
 414
 415 %token <Ast_c.info> TOPar TCPar TOBrace TCBrace TOCro TCCro
 416 %token <Ast_c.info> TDot TComma TPtrOp
 417 %token <Ast_c.info> TInc TDec
 418 %token <Ast_c.assignOp * Ast_c.info> TAssign
 419 %token <Ast_c.info> TEq
 420 %token <Ast_c.info> TWhy  TTilde TBang
 421 %token <Ast_c.info> TEllipsis
 422 %token <Ast_c.info> TDotDot
 423
 424 %token <Ast_c.info> TPtVirg
 425 %token <Ast_c.info>
 426        TOrLog TAndLog TOr TXor TAnd  TEqEq TNotEq TInf TSup TInfEq TSupEq
 427        TShl TShr
 428        TPlus TMinus TMul TDiv TMod
 429
 430 %token <Ast_c.info>
 431        Tchar Tshort Tint Tdouble Tfloat Tlong Tunsigned Tsigned Tvoid
 432        Tsize_t Tssize_t Tptrdiff_t
 433        Tauto Tregister Textern Tstatic
 434        Ttypedef
 435        Tconst Tvolatile
 436        Tstruct Tunion Tenum
 437        Tbreak Telse Tswitch Tcase Tcontinue Tfor Tdo Tif  Twhile Treturn
 438        Tgoto Tdefault
 439        Tsizeof Tnew Tdelete TOParCplusplusInit
 440
 441 /*(* C99 *)*/
 442 %token <Ast_c.info>
 443        Trestrict
 444
 445 /*(*-----------------------------------------*)*/
 446 /*(* gccext: extra tokens *)*/
 447 /*(*-----------------------------------------*)*/
 448 %token <Ast_c.info> Tasm
 449 %token <Ast_c.info> Tattribute
 450 %token <Ast_c.info> TattributeNoarg
 451 %token <Ast_c.info> Tinline
 452 %token <Ast_c.info> Ttypeof
 453
 454 /*(*-----------------------------------------*)*/
 455 /*(* cppext: extra tokens *)*/
 456 /*(*-----------------------------------------*)*/
 457 /*(* coupling with Token_helpers.is_cpp_token *)*/
 458
 459
 460 /*(*---------------*)*/
 461 /*(* define        *)*/
 462 /*(*---------------*)*/
 463
 464 %token <Ast_c.info> TDefine
 465 %token <(string * Ast_c.info)> TDefParamVariadic
 466
 467 /*(* disappear after fix_tokens_define *)*/
 468 %token <Ast_c.info> TCppEscapedNewline
 469
 470 %token <Ast_c.info> TCppConcatOp
 471
 472 /*(* appear    after fix_tokens_define *)*/
 473 %token <Ast_c.info> TOParDefine
 474 %token <Ast_c.info> TOBraceDefineInit
 475
 476 %token <(string * Ast_c.info)> TIdentDefine /*(* same *)*/
 477 %token <Ast_c.info>            TDefEOL      /*(* same *)*/
 478
 479
 480 /*(*---------------*)*/
 481 /*(* include       *)*/
 482 /*(*---------------*)*/
 483
 484
 485 /*(* used only in lexer_c, then transformed in comment or splitted in tokens *)*/
 486 %token <(string * string * bool ref * Ast_c.info)> TInclude
 487
 488 /*(* tokens coming from above, generated in parse_c from TInclude, etc *)*/
 489 %token <(Ast_c.info * bool ref)> TIncludeStart
 490 %token <(string * Ast_c.info)> TIncludeFilename
 491
 492
 493 /*(*---------------*)*/
 494 /*(* ifdef         *)*/
 495 /*(*---------------*)*/
 496
 497 /*(* coupling: Token_helpers.is_cpp_instruction *)*/
 498 %token <((int * int) option ref * Ast_c.info)>
 499   TIfdef TIfdefelse TIfdefelif TEndif
 500 %token <(bool * (int * int) option ref * Ast_c.info)>
 501   TIfdefBool TIfdefMisc TIfdefVersion
 502
 503 /*(*---------------*)*/
 504 /*(* other         *)*/
 505 /*(*---------------*)*/
 506
 507 %token <Ast_c.info> TUndef
 508
 509 %token <Ast_c.info> TCppDirectiveOther
 510
 511 /*(*---------------*)*/
 512 /*(* macro use     *)*/
 513 /*(*---------------*)*/
 514
 515 /*(* appear  after fix_tokens_cpp, cf also parsing_hacks#hint *)*/
 516
 517 %token <(string * Ast_c.info)>            TMacroAttr
 518 %token <(string * Ast_c.info)>            TMacroStmt
 519 %token <(string * Ast_c.info)> TMacroIdentBuilder
 520 /*(* no need value for the moment *)*/
 521 %token <(string * Ast_c.info)>            TMacroString
 522 %token <(string * Ast_c.info)> TMacroDecl
 523 %token <Ast_c.info>            TMacroDeclConst
 524
 525 %token <(string * Ast_c.info)> TMacroIterator
 526 /*(*
 527 %token <(string * Ast_c.info)> TMacroTop
 528 %token <(string * Ast_c.info)> TMacroStructDecl
 529 *)*/
 530
 531 %token <(string * Ast_c.info)>            TMacroAttrStorage
 532
 533
 534 /*(*---------------*)*/
 535 /*(* other         *)*/
 536 /*(*---------------*)*/
 537
 538
 539 /*(* should disappear after parsing_hack *)*/
 540 %token <Ast_c.info> TCommentSkipTagStart TCommentSkipTagEnd
 541
 542
 543 /*(* appear after parsing_hack *)*/
 544 %token <Ast_c.info> TCParEOL
 545
 546 %token <Ast_c.info> TAction
 547
 548
 549 /*(* TCommentMisc still useful ? obsolete ? *)*/
 550 %token <Ast_c.info> TCommentMisc
 551 %token <(Token_c.cppcommentkind * Ast_c.info)> TCommentCpp
 552
 553
 554 /*(*-----------------------------------------*)*/
 555 %token <Ast_c.info> EOF
 556
 557 /*(*-----------------------------------------*)*/
 558
 559 /*(* must be at the top so that it has the lowest priority *)*/
 560 %nonassoc SHIFTHERE
 561
 562 %nonassoc Telse
 563
 564 %left TOrLog
 565 %left TAndLog
 566 %left TOr
 567 %left TXor
 568 %left TAnd
 569 %left TEqEq TNotEq
 570 %left TInf TSup TInfEq TSupEq
 571 %left TShl TShr
 572 %left TPlus TMinus
 573 %left TMul TDiv TMod
 574
 575 /*(*************************************************************************)*/
 576 /*(* Rules type declaration *)*/
 577 /*(*************************************************************************)*/
 578
 579 %start main celem statement expr type_name
 580 %type <Ast_c.program> main
 581 %type <Ast_c.toplevel> celem
 582
 583 %type <Ast_c.statement> statement
 584 %type <Ast_c.expression> expr
 585 %type <Ast_c.fullType> type_name
 586
 587 %%
 588 /*(*************************************************************************)*/
 589 /*
 590 (* TOC:
 591  * toplevel (obsolete)
 592  *
 593  * ident
 594  * expression
 595  * statement
 596  * types with
 597  *   - left part (type_spec, qualif),
 598  *   - right part (declarator, abstract declarator)
 599  *   - aux part (parameters)
 600  * declaration, storage, initializers
 601  * struct
 602  * enum
 603  * cpp directives
 604  * celem (=~ main)
 605  *
 606  * generic workarounds (obrace, cbrace for context setting)
 607  * xxx_list, xxx_opt
 608  *)
 609 */
 610 /*(*************************************************************************)*/
 611
 612 /*(*************************************************************************)*/
 613 /*(* toplevel *)*/
 614 /*(*************************************************************************)*/
 615 /*(* no more used; now that use error recovery *)*/
 616
 617 main:
 618  translation_unit EOF     { $1 }
 619
 620 translation_unit:
 621  | external_declaration
 622      { !LP._lexer_hint.context_stack <- [LP.InTopLevel];   [$1] }
 623  | translation_unit external_declaration
 624      { !LP._lexer_hint.context_stack <- [LP.InTopLevel]; $1 ++ [$2] }
 625
 626
 627
 628 /*(*************************************************************************)*/
 629 /*(* ident *)*/
 630 /*(*************************************************************************)*/
 631
 632 /*(* Why this ? Why not s/ident/TIdent ? cos there is multiple namespaces in C,
 633    * so a label can have the same name that a typedef, same for field and tags
 634    * hence sometimes the use of ident  instead of TIdent.
 635    *)*/
 636 ident:
 637  | TIdent       { $1 }
 638  | TypedefIdent { $1 }
 639
 640
 641 identifier:
 642  | TIdent       { $1 }
 643
 644 /*
 645 (* cppext: string concatenation of idents
 646  * also cppext: gccext: ##args for variadic macro
 647  *)
 648 */
 649 identifier_cpp:
 650  | TIdent
 651      { RegularName (mk_string_wrap $1) }
 652  | ident_extra_cpp { $1 }
 653
 654 ident_cpp:
 655  | TIdent
 656      { RegularName (mk_string_wrap $1) }
 657  | TypedefIdent
 658      { RegularName (mk_string_wrap $1) }
 659  | ident_extra_cpp { $1 }
 660
 661 ident_extra_cpp:
 662  | TIdent TCppConcatOp identifier_cpp_list
 663      {
 664        CppConcatenatedName (
 665          match $3 with
 666          | [] -> raise Impossible
 667          | (x,concatnull)::xs ->
 668              assert(null concatnull);
 669              (mk_string_wrap $1, [])::(x,[$2])::xs
 670        )
 671    }
 672  | TCppConcatOp TIdent
 673      { CppVariadicName (fst $2, [$1; snd $2]) }
 674  | TMacroIdentBuilder TOPar param_define_list TCPar
 675      { CppIdentBuilder ((fst $1, [snd $1;$2;$4]), $3) }
 676
 677 identifier_cpp_list:
 678  | TIdent { [mk_string_wrap $1, []] }
 679  | identifier_cpp_list TCppConcatOp TIdent { $1 ++ [mk_string_wrap $3, [$2]] }
 680
 681 /*(*************************************************************************)*/
 682 /*(* expr *)*/
 683 /*(*************************************************************************)*/
 684
 685 expr:
 686  | assign_expr             { $1 }
 687  | expr TComma assign_expr { mk_e (Sequence ($1,$3)) [$2] }
 688
 689 /*(* bugfix: in C grammar they put unary_expr, but in fact it must be
 690    * cast_expr, otherwise (int * ) xxx = &yy; is not allowed
 691    *)*/
 692 assign_expr:
 693  | cond_expr                     { $1 }
 694  | cast_expr TAssign assign_expr { mk_e(Assignment ($1,fst $2,$3)) [snd $2]}
 695  | cast_expr TEq     assign_expr { mk_e(Assignment ($1,SimpleAssign,$3)) [$2]}
 696
 697 /*(* gccext: allow optional then part hence gcc_opt_expr
 698    * bugfix: in C grammar they put TDotDot cond_expr, but in fact it must be
 699    * assign_expr, otherwise   pnp ? x : x = 0x388  is not allowed
 700    *)*/
 701 cond_expr:
 702  | arith_expr
 703      { $1 }
 704  | arith_expr TWhy gcc_opt_expr TDotDot assign_expr
 705      { mk_e (CondExpr ($1,$3,$5)) [$2;$4] }
 706
 707
 708 arith_expr:
 709  | cast_expr                     { $1 }
 710  | arith_expr TMul    arith_expr { mk_e(Binary ($1, Arith Mul,      $3)) [$2] }
 711  | arith_expr TDiv    arith_expr { mk_e(Binary ($1, Arith Div,      $3)) [$2] }
 712  | arith_expr TMod    arith_expr { mk_e(Binary ($1, Arith Mod,      $3)) [$2] }
 713  | arith_expr TPlus   arith_expr { mk_e(Binary ($1, Arith Plus,     $3)) [$2] }
 714  | arith_expr TMinus  arith_expr { mk_e(Binary ($1, Arith Minus,    $3)) [$2] }
 715  | arith_expr TShl    arith_expr { mk_e(Binary ($1, Arith DecLeft,  $3)) [$2] }
 716  | arith_expr TShr    arith_expr { mk_e(Binary ($1, Arith DecRight, $3)) [$2] }
 717  | arith_expr TInf    arith_expr { mk_e(Binary ($1, Logical Inf,    $3)) [$2] }
 718  | arith_expr TSup    arith_expr { mk_e(Binary ($1, Logical Sup,    $3)) [$2] }
 719  | arith_expr TInfEq  arith_expr { mk_e(Binary ($1, Logical InfEq,  $3)) [$2] }
 720  | arith_expr TSupEq  arith_expr { mk_e(Binary ($1, Logical SupEq,  $3)) [$2] }
 721  | arith_expr TEqEq   arith_expr { mk_e(Binary ($1, Logical Eq,     $3)) [$2] }
 722  | arith_expr TNotEq  arith_expr { mk_e(Binary ($1, Logical NotEq,  $3)) [$2] }
 723  | arith_expr TAnd    arith_expr { mk_e(Binary ($1, Arith And,      $3)) [$2] }
 724  | arith_expr TOr     arith_expr { mk_e(Binary ($1, Arith Or,       $3)) [$2] }
 725  | arith_expr TXor    arith_expr { mk_e(Binary ($1, Arith Xor,      $3)) [$2] }
 726  | arith_expr TAndLog arith_expr { mk_e(Binary ($1, Logical AndLog, $3)) [$2] }
 727  | arith_expr TOrLog  arith_expr { mk_e(Binary ($1, Logical OrLog,  $3)) [$2] }
 728
 729 cast_expr:
 730  | unary_expr                        { $1 }
 731  | topar2 type_name tcpar2 cast_expr { mk_e(Cast ($2, $4)) [$1;$3] }
 732
 733 unary_expr:
 734  | postfix_expr                    { $1 }
 735  | TInc unary_expr                 { mk_e(Infix ($2, Inc))    [$1] }
 736  | TDec unary_expr                 { mk_e(Infix ($2, Dec))    [$1] }
 737  | unary_op cast_expr              { mk_e(Unary ($2, fst $1)) [snd $1] }
 738  | Tsizeof unary_expr              { mk_e(SizeOfExpr ($2))    [$1] }
 739  | Tsizeof topar2 type_name tcpar2 { mk_e(SizeOfType ($3))    [$1;$2;$4] }
 740  | Tnew new_argument               { mk_e(New $2)             [$1] }
 741  | Tdelete cast_expr               { mk_e(Delete $2)          [$1] }
 742
 743 new_argument:
 744  | TIdent TOPar argument_list_ne TCPar
 745      { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in
 746        Left (mk_e(FunCall (fn, $3)) [$2;$4]) }
 747  | TIdent TOPar TCPar
 748      { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in
 749        Left(mk_e(FunCall (fn, [])) [$2;$3]) }
 750  | TypedefIdent TOPar argument_list_ne TCPar
 751      { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in
 752        Left (mk_e(FunCall (fn, $3)) [$2;$4]) }
 753  | TypedefIdent TOPar TCPar
 754      { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in
 755        Left (mk_e(FunCall (fn, [])) [$2;$3]) }
 756  | type_spec
 757      { let ty = addTypeD ($1,nullDecl) in
 758        let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam ty in
 759        Right (ArgType { p_namei = None; p_type = returnType;
 760                         p_register = hasreg, iihasreg;
 761                       } )
 762      }
 763  | new_argument TOCro expr TCCro
 764      {
 765        match $1 with
 766          Left(e) -> Left(mk_e(ArrayAccess (e, $3)) [$2;$4])
 767        | Right(ArgType(ty)) -> (* lots of hacks to make the right type *)
 768            let fty = mk_ty (Array (Some $3, ty.Ast_c.p_type)) [$2;$4] in
 769            let pty = { ty with p_type = fty } in
 770            Right(ArgType pty)
 771        | _ -> raise Impossible
 772      }
 773
 774 unary_op:
 775  | TAnd   { GetRef,     $1 }
 776  | TMul   { DeRef,      $1 }
 777  | TPlus  { UnPlus,     $1 }
 778  | TMinus { UnMinus,    $1 }
 779  | TTilde { Tilde,      $1 }
 780  | TBang  { Not,        $1 }
 781  /*(* gccext: have that a lot in old kernel to get address of local label.
 782     * cf gcc manual "local labels as values".
 783     *)*/
 784  | TAndLog { GetRefLabel, $1 }
 785
 786 postfix_expr:
 787  | primary_expr               { $1 }
 788  | postfix_expr TOCro expr TCCro
 789      { mk_e(ArrayAccess ($1, $3)) [$2;$4] }
 790  | postfix_expr TOPar argument_list_ne TCPar
 791      { mk_e(FunCall ($1, $3)) [$2;$4] }
 792  | postfix_expr TOPar  TCPar  { mk_e(FunCall ($1, [])) [$2;$3] }
 793  | postfix_expr TDot   ident_cpp { mk_e(RecordAccess   ($1,$3)) [$2] }
 794  | postfix_expr TPtrOp ident_cpp { mk_e(RecordPtAccess ($1,$3)) [$2] }
 795  | postfix_expr TInc          { mk_e(Postfix ($1, Inc)) [$2] }
 796  | postfix_expr TDec          { mk_e(Postfix ($1, Dec)) [$2] }
 797
 798  /*(* gccext: also called compound literals *)*/
 799  | topar2 type_name tcpar2 TOBrace TCBrace
 800      { mk_e(Constructor ($2, [])) [$1;$3;$4;$5] }
 801  | topar2 type_name tcpar2 TOBrace initialize_list gcc_comma_opt TCBrace
 802      { mk_e(Constructor ($2, List.rev $5)) ([$1;$3;$4;$7] ++ $6) }
 803
 804
 805 primary_expr:
 806  | identifier_cpp  { mk_e(Ident  ($1)) [] }
 807  | TInt
 808     { let (str,(sign,base)) = fst $1 in
 809       mk_e(Constant (Int (str,Si(sign,base)))) [snd $1] }
 810  | TFloat  { mk_e(Constant (Float  (fst $1))) [snd $1] }
 811  | TString { mk_e(Constant (String (fst $1))) [snd $1] }
 812  | TChar   { mk_e(Constant (Char   (fst $1))) [snd $1] }
 813  | TOPar expr TCPar { mk_e(ParenExpr ($2)) [$1;$3] }  /*(* forunparser: *)*/
 814
 815  /*(* gccext: cppext: TODO better ast ? *)*/
 816  | TMacroString { mk_e(Constant (MultiString [fst $1])) [snd $1] }
 817  | string_elem string_list
 818      { mk_e(Constant (MultiString ["TODO: MultiString"])) ($1 ++ $2) }
 819
 820  /*(* gccext: allow statement as expressions via ({ statement }) *)*/
 821  | TOPar compound TCPar  { mk_e(StatementExpr ($2)) [$1;$3] }
 822
 823
 824
 825 /*(*----------------------------*)*/
 826 /*(* cppext: *)*/
 827 /*(*----------------------------*)*/
 828
 829 /*(* cppext: *)*/
 830 /*(* to avoid conflicts have to introduce a _not_empty (ne) version *)*/
 831 argument_ne:
 832  | assign_expr { Left $1 }
 833  | parameter_decl { Right (ArgType $1)  }
 834  | action_higherordermacro_ne { Right (ArgAction $1) }
 835
 836
 837 argument:
 838  | assign_expr { Left $1 }
 839  | parameter_decl { Right (ArgType $1)  }
 840  /*(* had conflicts before, but julia fixed them *)*/
 841  | action_higherordermacro { Right (ArgAction $1) }
 842
 843 action_higherordermacro_ne:
 844  | taction_list_ne
 845      { if null $1
 846        then ActMisc [Ast_c.fakeInfo()]
 847        else ActMisc $1
 848      }
 849
 850
 851 action_higherordermacro:
 852  | taction_list
 853      { if null $1
 854        then ActMisc [Ast_c.fakeInfo()]
 855        else ActMisc $1
 856      }
 857
 858
 859 /*(*----------------------------*)*/
 860 /*(* workarounds *)*/
 861 /*(*----------------------------*)*/
 862
 863 /*(* would like evalInt $1 but require too much info *)*/
 864 const_expr: cond_expr { $1  }
 865
 866
 867 topar2: TOPar { et "topar2" (); $1  }
 868 tcpar2: TCPar { et "tcpar2" (); $1 (*TODO? et ? sure ? c pas dt plutot ? *) }
 869
 870
 871
 872 /*(*************************************************************************)*/
 873 /*(* statement *)*/
 874 /*(*************************************************************************)*/
 875
 876 statement: statement2 { mk_st (fst $1) (snd $1) }
 877
 878 statement2:
 879  | labeled         { Labeled      (fst $1), snd $1 }
 880  | compound        { Compound     (fst $1), snd $1 }
 881  | expr_statement  { ExprStatement(fst $1), snd $1 }
 882  | selection       { Selection    (fst $1), snd $1 ++ [fakeInfo()] }
 883  | iteration       { Iteration    (fst $1), snd $1 ++ [fakeInfo()] }
 884  | jump TPtVirg    { Jump         (fst $1), snd $1 ++ [$2] }
 885
 886  /*(* gccext: *)*/
 887  | Tasm TOPar asmbody TCPar TPtVirg             { Asm $3, [$1;$2;$4;$5] }
 888  | Tasm Tvolatile TOPar asmbody TCPar TPtVirg   { Asm $4, [$1;$2;$3;$5;$6] }
 889
 890  /*(* cppext: *)*/
 891  | TMacroStmt { MacroStmt, [snd $1] }
 892
 893
 894
 895
 896 /*(* note that case 1: case 2: i++;    would be correctly parsed, but with
 897    * a Case  (1, (Case (2, i++)))  :(
 898    *)*/
 899 labeled:
 900  | ident_cpp        TDotDot statement   { Label ($1, $3),  [$2] }
 901  | Tcase const_expr TDotDot statement   { Case ($2, $4),       [$1; $3] }
 902  | Tcase const_expr TEllipsis const_expr TDotDot statement
 903      { CaseRange ($2, $4, $6), [$1;$3;$5] } /*(* gccext: allow range *)*/
 904  | Tdefault         TDotDot statement   { Default $3,             [$1; $2] }
 905
 906 end_labeled:
 907  /*(* gccext:  allow toto: }
 908     * was generating each 30 shift/Reduce conflicts,
 909     * mais ca va, ca fait ce qu'il faut.
 910     * update: julia fixed the problem by introducing end_labeled
 911     * and modifying below stat_or_decl_list
 912     *)*/
 913  | ident_cpp            TDotDot
 914      { Label ($1, (mk_st (ExprStatement None) Ast_c.noii)), [$2] }
 915  | Tcase const_expr TDotDot
 916      { Case ($2, (mk_st (ExprStatement None) Ast_c.noii)), [$1;$3] }
 917  | Tdefault         TDotDot
 918      { Default (mk_st (ExprStatement None) Ast_c.noii),    [$1; $2] }
 919
 920
 921
 922
 923
 924 compound: tobrace compound2 tcbrace { $2, [$1; $3]  }
 925
 926
 927 /*
 928 (* cppext: because of cpp, some stuff looks like declaration but are in
 929  * fact statement but too hard to figure out, and if parse them as
 930  * expression, then we force to have first decls and then exprs, then
 931  * will have a parse error. So easier to let mix decl/statement.
 932  * Moreover it helps to not make such a difference between decl and
 933  * statement for further coccinelle phases to factorize code.
 934 *)*/
 935 compound2:
 936  |                   { ([]) }
 937  | stat_or_decl_list { $1 }
 938
 939
 940 stat_or_decl_list:
 941  | stat_or_decl                   { [$1] }
 942  /*(* gccext: to avoid conflicts, cf end_labeled above *)*/
 943  | end_labeled  { [StmtElem (mk_st (Labeled  (fst $1)) (snd $1))] }
 944  /*(* old: conflicts | stat_or_decl_list stat_or_decl { $1 ++ [$2] } *)*/
 945  | stat_or_decl stat_or_decl_list { $1 :: $2 }
 946
 947 stat_or_decl:
 948  | decl      { StmtElem (mk_st (Decl ($1 Ast_c.LocalDecl)) Ast_c.noii) }
 949  | statement { StmtElem $1 }
 950
 951   /*(* gccext: *)*/
 952  | function_definition { StmtElem (mk_st (NestedFunc $1) Ast_c.noii) }
 953
 954  /* (* cppext: *)*/
 955  | cpp_directive
 956      { CppDirectiveStmt $1 }
 957  | cpp_ifdef_directive/*(* stat_or_decl_list ...*)*/
 958      { IfdefStmt $1 }
 959
 960
 961 expr_statement:
 962  | TPtVirg      { None,    [$1] }
 963  | expr TPtVirg { Some $1, [$2] }
 964
 965 selection:
 966  | Tif TOPar expr TCPar statement              %prec SHIFTHERE
 967      { If ($3, $5, (mk_st (ExprStatement None) Ast_c.noii)),   [$1;$2;$4] }
 968  | Tif TOPar expr TCPar statement Telse statement
 969      { If ($3, $5, $7),  [$1;$2;$4;$6] }
 970  | Tswitch TOPar expr TCPar statement
 971      { Switch ($3,$5),   [$1;$2;$4]  }
 972
 973 iteration:
 974  | Twhile TOPar expr TCPar statement
 975      { While ($3,$5),                [$1;$2;$4] }
 976  | Tdo statement Twhile TOPar expr TCPar TPtVirg
 977      { DoWhile ($2,$5),              [$1;$3;$4;$6;$7] }
 978  | Tfor TOPar expr_statement expr_statement TCPar statement
 979      { For ($3,$4,(None, []),$6),    [$1;$2;$5]}
 980  | Tfor TOPar expr_statement expr_statement expr TCPar statement
 981      { For ($3,$4,(Some $5, []),$7), [$1;$2;$6] }
 982  /*(* c++ext: for(int i = 0; i < n; i++)*)*/
 983  | Tfor TOPar decl expr_statement expr_opt TCPar statement
 984      {
 985        (* pr2 "DECL in for"; *)
 986        MacroIteration ("toto", [], $7),[$1;$2;$6] (* TODOfake ast, TODO need decl2 ? *)
 987      }
 988  /*(* cppext: *)*/
 989  | TMacroIterator TOPar argument_list_ne TCPar statement
 990      { MacroIteration (fst $1, $3, $5), [snd $1;$2;$4] }
 991  | TMacroIterator TOPar TCPar statement
 992      { MacroIteration (fst $1, [], $4), [snd $1;$2;$3] }
 993
 994 /*(* the ';' in the caller grammar rule will be appended to the infos *)*/
 995 jump:
 996  | Tgoto ident_cpp  { Goto ($2),  [$1] }
 997  | Tcontinue    { Continue,       [$1] }
 998  | Tbreak       { Break,          [$1] }
 999  | Treturn      { Return,         [$1] }
1000  | Treturn expr { ReturnExpr $2,  [$1] }
1001  | Tgoto TMul expr { GotoComputed $3, [$1;$2] }
1002
1003
1004
1005 /*(*----------------------------*)*/
1006 /*(* gccext: *)*/
1007 /*(*----------------------------*)*/
1008 string_elem:
1009  | TString { [snd $1] }
1010  /*(* cppext:  ex= printk (KERN_INFO "xxx" UTS_RELEASE)  *)*/
1011  | TMacroString { [snd $1] }
1012
1013
1014 asmbody:
1015  | string_list colon_asm_list  { $1, $2 }
1016  | string_list { $1, [] } /*(* in old kernel *)*/
1017
1018
1019 colon_asm: TDotDot colon_option_list { Colon $2, [$1]   }
1020
1021 colon_option:
1022  | TString                      { ColonMisc, [snd $1] }
1023  | TString TOPar asm_expr TCPar { ColonExpr $3, [snd $1; $2;$4] }
1024  /*(* cppext: certainly a macro *)*/
1025  | TOCro identifier TCCro TString TOPar asm_expr TCPar
1026      { ColonExpr $6, [$1;snd $2;$3;snd $4; $5; $7 ] }
1027  | identifier                       { ColonMisc, [snd $1] }
1028  | /*(* empty *)*/                  { ColonMisc, [] }
1029
1030 asm_expr: assign_expr { $1 }
1031
1032 /*(*************************************************************************)*/
1033 /*(* types *)*/
1034 /*(*************************************************************************)*/
1035
1036
1037 /*(*-----------------------------------------------------------------------*)*/
1038 /*(* Type spec, left part of a type *)*/
1039 /*(*-----------------------------------------------------------------------*)*/
1040 type_spec2:
1041  | Tvoid                { Right3 (BaseType Void),            [$1] }
1042  | Tchar                { Right3 (BaseType (IntType CChar)), [$1]}
1043  | Tint                 { Right3 (BaseType (IntType (Si (Signed,CInt)))), [$1]}
1044  | Tfloat               { Right3 (BaseType (FloatType CFloat)),  [$1]}
1045  | Tdouble              { Right3 (BaseType (FloatType CDouble)), [$1] }
1046  | Tsize_t              { Right3 (BaseType SizeType),            [$1] }
1047  | Tssize_t             { Right3 (BaseType SSizeType),           [$1] }
1048  | Tptrdiff_t           { Right3 (BaseType PtrDiffType),         [$1] }
1049  | Tshort               { Middle3 Short,  [$1]}
1050  | Tlong                { Middle3 Long,   [$1]}
1051  | Tsigned              { Left3 Signed,   [$1]}
1052  | Tunsigned            { Left3 UnSigned, [$1]}
1053  | struct_or_union_spec { Right3 (fst $1), snd $1 }
1054  | enum_spec            { Right3 (fst $1), snd $1 }
1055
1056  /*
1057  (* parse_typedef_fix1: cant put: TIdent {} cos it make the grammar
1058   * ambiguous, generates lots of conflicts => we must
1059   * use some tricks: we make the lexer and parser cooperate, cf lexerParser.ml.
1060   *
1061   * parse_typedef_fix2: this is not enough, and you must use
1062   * parse_typedef_fix2 to fully manage typedef problems in grammar.
1063   *
1064   * parse_typedef_fix3:
1065   *
1066   * parse_typedef_fix4: try also to do now some consistency checking in
1067   * Parse_c
1068   *)*/
1069  | TypedefIdent
1070      { let name = RegularName (mk_string_wrap $1) in
1071        Right3 (TypeName (name, Ast_c.noTypedefDef())),[] }
1072
1073  | Ttypeof TOPar assign_expr TCPar { Right3 (TypeOfExpr ($3)), [$1;$2;$4] }
1074  | Ttypeof TOPar type_name   TCPar { Right3 (TypeOfType ($3)), [$1;$2;$4] }
1075
1076 /*(*----------------------------*)*/
1077 /*(* workarounds *)*/
1078 /*(*----------------------------*)*/
1079
1080 type_spec: type_spec2    { dt "type" (); $1   }
1081
1082 /*(*-----------------------------------------------------------------------*)*/
1083 /*(* Qualifiers *)*/
1084 /*(*-----------------------------------------------------------------------*)*/
1085
1086 type_qualif:
1087  | Tconst    { {const=true  ; volatile=false}, $1 }
1088  | Tvolatile { {const=false ; volatile=true},  $1 }
1089  /*(* C99 *)*/
1090  | Trestrict { (* TODO *) {const=false ; volatile=false},  $1 }
1091
1092
1093 /*(*-----------------------------------------------------------------------*)*/
1094 /*(* gccext: attributes  *)*/
1095 /*(*-----------------------------------------------------------------------*)*/
1096
1097 attribute:
1098  | Tattribute TOPar /*stuff*/ TCPar { raise Todo }
1099  /*(* cppext: *)*/
1100  | TMacroAttr { Attribute (fst $1), [snd $1] }
1101
1102 attribute_storage:
1103  | TMacroAttrStorage { $1 }
1104
1105 type_qualif_attr:
1106  | type_qualif { $1 }
1107 /*(*TODO !!!!! *)*/
1108  | TMacroAttr { {const=true  ; volatile=false}, snd $1   }
1109
1110 /*(*-----------------------------------------------------------------------*)*/
1111 /*(* Declarator, right part of a type + second part of decl (the ident)  *)*/
1112 /*(*-----------------------------------------------------------------------*)*/
1113
1114 /*
1115 (* declarator return a couple:
1116  *  (name, partial type (a function to be applied to return type))
1117  *
1118  * when int* f(int) we must return Func(Pointer int,int) and not
1119  * Pointer (Func(int,int)
1120  *)*/
1121
1122 declarator:
1123  | pointer direct_d { (fst $2, fun x -> x +> $1 +> (snd $2)  ) }
1124  | direct_d         { $1  }
1125
1126 /*(* so must do  int * const p; if the pointer is constant, not the pointee *)*/
1127 pointer:
1128  | tmul                   { fun x -> mk_ty (Pointer x) [$1] }
1129  | tmul pointer           { fun x -> mk_ty (Pointer ($2 x)) [$1] }
1130  | tmul type_qualif_list
1131      { fun x -> ($2.qualifD, mk_tybis (Pointer x) [$1])}
1132  | tmul type_qualif_list pointer
1133      { fun x -> ($2.qualifD, mk_tybis (Pointer ($3 x)) [$1]) }
1134
1135 tmul:
1136    TMul { $1 }
1137  | TAnd
1138      { if !Flag.c_plus_plus
1139      then $1
1140      else
1141        let i = Ast_c.parse_info_of_info $1 in
1142        raise (Semantic("& not allowed in C types, try -c++ option", i)) }
1143
1144
1145 direct_d:
1146  | identifier_cpp
1147      { ($1, fun x -> x) }
1148  | TOPar declarator TCPar      /*(* forunparser: old: $2 *)*/
1149      { (fst $2, fun x -> mk_ty (ParenType ((snd $2) x)) [$1;$3]) }
1150  | direct_d tocro            tccro
1151      { (fst $1,fun x->(snd $1) (mk_ty (Array (None,x)) [$2;$3])) }
1152  | direct_d tocro const_expr tccro
1153      { (fst $1,fun x->(snd $1) (mk_ty (Array (Some $3,x)) [$2;$4])) }
1154  | direct_d topar            tcpar
1155      { (fst $1,
1156        fun x->(snd $1)
1157          (mk_ty (FunctionType (x,(([],(false, []))))) [$2;$3]))
1158      }
1159  | direct_d topar parameter_type_list tcpar
1160      { (fst $1,fun x->(snd $1)
1161        (mk_ty (FunctionType (x, $3)) [$2;$4]))
1162      }
1163
1164
1165 /*(*----------------------------*)*/
1166 /*(* workarounds *)*/
1167 /*(*----------------------------*)*/
1168
1169 tocro: TOCro { et "tocro" ();$1 }
1170 tccro: TCCro { dt "tccro" ();$1 }
1171
1172 /*(*-----------------------------------------------------------------------*)*/
1173 abstract_declarator:
1174  | pointer                            { $1 }
1175  |         direct_abstract_declarator { $1 }
1176  | pointer direct_abstract_declarator { fun x -> x +> $2 +> $1 }
1177
1178 direct_abstract_declarator:
1179  | TOPar abstract_declarator TCPar /*(* forunparser: old: $2 *)*/
1180      { fun x -> mk_ty (ParenType ($2 x)) [$1;$3] }
1181
1182  | TOCro            TCCro
1183      { fun x -> mk_ty (Array (None, x)) [$1;$2] }
1184  | TOCro const_expr TCCro
1185      { fun x -> mk_ty (Array (Some $2, x)) [$1;$3] }
1186  | direct_abstract_declarator TOCro            TCCro
1187      { fun x -> $1 (mk_ty (Array (None, x))  [$2;$3]) }
1188  | direct_abstract_declarator TOCro const_expr TCCro
1189      { fun x -> $1 (mk_ty (Array (Some $3,x))  [$2;$4]) }
1190  | TOPar TCPar
1191      { fun x -> mk_ty (FunctionType (x, ([], (false,  [])))) [$1;$2] }
1192  | topar parameter_type_list tcpar
1193      { fun x -> mk_ty (FunctionType (x, $2))  [$1;$3] }
1194 /*(* subtle: here must also use topar, not TOPar, otherwise if have for
1195    * instance   (xxx ( * )(xxx)) cast, then the second xxx may still be a Tident
1196    * but we want to reduce topar, to set the InParameter so that
1197    * parsing_hack can get a chance to change the type of xxx into a typedef.
1198    * That's an example where parsing_hack and the lookahead of ocamlyacc does
1199    * not go very well together ... we got the info too late. We got
1200    * a similar pb with xxx xxx; declaration, cf parsing_hack.ml and the
1201    * "disable typedef cos special case ..." message.
1202 *)*/
1203  | direct_abstract_declarator topar tcpar
1204      { fun x -> $1 (mk_ty (FunctionType (x, (([], (false, []))))) [$2;$3]) }
1205  | direct_abstract_declarator topar parameter_type_list tcpar
1206      { fun x -> $1 (mk_ty (FunctionType (x, $3)) [$2;$4]) }
1207
1208 /*(*-----------------------------------------------------------------------*)*/
1209 /*(* Parameters (use decl_spec not type_spec just for 'register') *)*/
1210 /*(*-----------------------------------------------------------------------*)*/
1211 parameter_type_list:
1212  | parameter_list                  { ($1, (false, []))}
1213  | parameter_list TComma TEllipsis { ($1, (true,  [$2;$3])) }
1214
1215
1216 parameter_decl2:
1217  | decl_spec declaratorp
1218      { let ((returnType,hasreg),iihasreg) = fixDeclSpecForParam $1 in
1219        let (name, ftyp) = $2 in
1220        { p_namei = Some (name);
1221          p_type = ftyp returnType;
1222          p_register = (hasreg, iihasreg);
1223        }
1224      }
1225  | decl_spec abstract_declaratorp
1226      { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1 in
1227        { p_namei = None;
1228          p_type = $2 returnType;
1229          p_register = hasreg, iihasreg;
1230        }
1231      }
1232  | decl_spec
1233      { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1 in
1234        { p_namei = None;
1235          p_type = returnType;
1236          p_register = hasreg, iihasreg;
1237        }
1238      }
1239
1240
1241 /*(*----------------------------*)*/
1242 /*(* workarounds *)*/
1243 /*(*----------------------------*)*/
1244
1245 parameter_decl: parameter_decl2 { et "param" ();  $1 }
1246  | attributes parameter_decl2 { et "param" (); $2 }
1247
1248 declaratorp:
1249  | declarator  { LP.add_ident (str_of_name (fst $1)); $1 }
1250  /*(* gccext: *)*/
1251  | attributes declarator   { LP.add_ident (str_of_name (fst $2)); $2 }
1252  | declarator attributes   { LP.add_ident (str_of_name (fst $1)); $1 }
1253
1254 abstract_declaratorp:
1255  | abstract_declarator { $1 }
1256  /*(* gccext: *)*/
1257  | attributes abstract_declarator { $2 }
1258
1259 /*(*-----------------------------------------------------------------------*)*/
1260 /*(* helper type rules *)*/
1261 /*(*-----------------------------------------------------------------------*)*/
1262
1263 /*(* for struct and also typename *)*/
1264 /*(* cant put decl_spec cos no storage is allowed for field struct *)*/
1265 spec_qualif_list2:
1266  | type_spec                    { addTypeD ($1, nullDecl) }
1267  | type_qualif                  { {nullDecl with qualifD = (fst $1,[snd $1])}}
1268  | type_spec   spec_qualif_list { addTypeD ($1,$2)   }
1269  | type_qualif spec_qualif_list { addQualifD ($1,$2) }
1270
1271 spec_qualif_list: spec_qualif_list2            {  dt "spec_qualif" (); $1 }
1272
1273
1274 /*(* for pointers in direct_declarator and abstract_declarator *)*/
1275 type_qualif_list:
1276  | type_qualif_attr                  { {nullDecl with qualifD = (fst $1,[snd $1])} }
1277  | type_qualif_list type_qualif_attr { addQualifD ($2,$1) }
1278
1279
1280
1281
1282
1283
1284 /*(*-----------------------------------------------------------------------*)*/
1285 /*(* xxx_type_id *)*/
1286 /*(*-----------------------------------------------------------------------*)*/
1287
1288 type_name:
1289  | spec_qualif_list
1290      { let (returnType, _) = fixDeclSpecForDecl $1 in  returnType }
1291  | spec_qualif_list abstract_declaratort
1292      { let (returnType, _) = fixDeclSpecForDecl $1 in $2 returnType }
1293
1294
1295
1296 abstract_declaratort:
1297  | abstract_declarator { $1 }
1298  /*(* gccext: *)*/
1299  | attributes abstract_declarator { $2 }
1300
1301
1302 /*(*************************************************************************)*/
1303 /*(* declaration and initializers *)*/
1304 /*(*************************************************************************)*/
1305
1306 decl2:
1307  | decl_spec TPtVirg
1308      { function local ->
1309        let (returnType,storage) = fixDeclSpecForDecl $1 in
1310        let iistart = Ast_c.fakeInfo () in
1311        DeclList ([{v_namei = None; v_type = returnType;
1312                    v_storage = unwrap storage; v_local = local;
1313                    v_attr = Ast_c.noattr;
1314                    v_type_bis = ref None;
1315                 },[]],
1316                 ($2::iistart::snd storage))
1317      }
1318  | decl_spec init_declarator_list TPtVirg
1319      { function local ->
1320        let (returnType,storage) = fixDeclSpecForDecl $1 in
1321        let iistart = Ast_c.fakeInfo () in
1322        DeclList (
1323          ($2 +> List.map (fun ((((name,f),attrs), ini), iivirg) ->
1324            let s = str_of_name name in
1325            if fst (unwrap storage) =*= StoTypedef
1326            then LP.add_typedef s;
1327            {v_namei = Some (name, ini);
1328             v_type = f returnType;
1329             v_storage = unwrap storage;
1330             v_local = local;
1331             v_attr = attrs;
1332             v_type_bis = ref None;
1333            },
1334            iivirg
1335          )
1336          ),  ($3::iistart::snd storage))
1337      }
1338  /*(* cppext: *)*/
1339
1340  | TMacroDecl TOPar argument_list TCPar TPtVirg
1341      { function _ ->
1342        MacroDecl ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]) }
1343  | Tstatic TMacroDecl TOPar argument_list TCPar TPtVirg
1344      { function _ ->
1345        MacroDecl ((fst $2, $4), [snd $2;$3;$5;$6;fakeInfo();$1]) }
1346  | Tstatic TMacroDeclConst TMacroDecl TOPar argument_list TCPar TPtVirg
1347      { function _ ->
1348        MacroDecl ((fst $3, $5), [snd $3;$4;$6;$7;fakeInfo();$1;$2])}
1349
1350
1351 /*(*-----------------------------------------------------------------------*)*/
1352 decl_spec2:
1353  | storage_class_spec      { {nullDecl with storageD = (fst $1, [snd $1]) } }
1354  | type_spec               { addTypeD ($1,nullDecl) }
1355  | type_qualif             { {nullDecl with qualifD  = (fst $1, [snd $1]) } }
1356  | Tinline                 { {nullDecl with inlineD = (true, [$1]) } }
1357  | storage_class_spec decl_spec2 { addStorageD ($1, $2) }
1358  | type_spec          decl_spec2 { addTypeD    ($1, $2) }
1359  | type_qualif        decl_spec2 { addQualifD  ($1, $2) }
1360  | Tinline            decl_spec2 { addInlineD ((true, $1), $2) }
1361
1362 /*(* can simplify by putting all in _opt ? must have at least one otherwise
1363    *  decl_list is ambiguous ? (no cos have ';' between decl)
1364    *)*/
1365
1366
1367 storage_class_spec2:
1368  | Tstatic      { Sto Static,  $1 }
1369  | Textern      { Sto Extern,  $1 }
1370  | Tauto        { Sto Auto,    $1 }
1371  | Tregister    { Sto Register,$1 }
1372  | Ttypedef     { StoTypedef,  $1 }
1373
1374 storage_class_spec:
1375  /*(* gccext: *)*/
1376  | storage_class_spec2 { $1 }
1377  | storage_class_spec2 attribute_storage_list { $1 (* TODO *) }
1378
1379
1380
1381 /*(*----------------------------*)*/
1382 /*(* workarounds *)*/
1383 /*(*----------------------------*)*/
1384
1385 decl:      decl2         { et "decl" (); $1 }
1386 decl_spec: decl_spec2    { dt "declspec" (); $1  }
1387
1388 /*(*-----------------------------------------------------------------------*)*/
1389 /*(* declarators (right part of type and variable) *)*/
1390 /*(*-----------------------------------------------------------------------*)*/
1391 init_declarator2:
1392  | declaratori                  { ($1, NoInit) }
1393  | declaratori teq initialize   { ($1, ValInit($2, $3)) }
1394  /* C++ only */
1395  | declaratori TOParCplusplusInit argument_list TCPar
1396      { ($1, ConstrInit($3,[$2;$4])) }
1397
1398
1399 /*(*----------------------------*)*/
1400 /*(* workarounds *)*/
1401 /*(*----------------------------*)*/
1402 teq: TEq  { et "teq" (); $1 }
1403
1404 init_declarator: init_declarator2  { dt "init" (); $1 }
1405
1406
1407 /*(*----------------------------*)*/
1408 /*(* gccext: *)*/
1409 /*(*----------------------------*)*/
1410
1411 declaratori:
1412  | declarator              { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr }
1413  /*(* gccext: *)*/
1414  | declarator gcc_asm_decl { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr }
1415  /*(* gccext: *)*/
1416  | attributes declarator   { LP.add_ident (str_of_name (fst $2)); $2, $1 }
1417  | declarator attributes   { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr (* TODO *) }
1418
1419
1420
1421 gcc_asm_decl:
1422  | Tasm TOPar asmbody TCPar              {  }
1423  | Tasm Tvolatile TOPar asmbody TCPar   {  }
1424
1425
1426 /*(*-----------------------------------------------------------------------*)*/
1427 initialize:
1428  | assign_expr
1429      { InitExpr $1,                [] }
1430  | tobrace_ini initialize_list gcc_comma_opt_struct  tcbrace_ini
1431      { InitList (List.rev $2),     [$1;$4]++$3 }
1432  | tobrace_ini tcbrace_ini
1433      { InitList [],       [$1;$2] } /*(* gccext: *)*/
1434
1435
1436 /*
1437 (* opti: This time we use the weird order of non-terminal which requires in
1438  * the "caller" to do a List.rev cos quite critical. With this weird order it
1439  * allows yacc to use a constant stack space instead of exploding if we would
1440  * do a  'initialize2 Tcomma initialize_list'.
1441  *)
1442 */
1443 initialize_list:
1444  | initialize2                        { [$1,   []] }
1445  | initialize_list TComma initialize2 { ($3,  [$2])::$1 }
1446
1447
1448 /*(* gccext: condexpr and no assign_expr cos can have ambiguity with comma *)*/
1449 initialize2:
1450  | cond_expr
1451      { InitExpr $1,   [] }
1452  | tobrace_ini initialize_list gcc_comma_opt_struct tcbrace_ini
1453      { InitList (List.rev $2),   [$1;$4]++$3 }
1454  | tobrace_ini tcbrace_ini
1455      { InitList [],  [$1;$2]  }
1456
1457  /*(* gccext: labeled elements, a.k.a designators *)*/
1458  | designator_list TEq initialize2
1459      { InitDesignators ($1, $3), [$2] }
1460
1461  /*(* gccext: old format *)*/
1462  | ident TDotDot initialize2
1463      { InitFieldOld (fst $1, $3),     [snd $1; $2] } /*(* in old kernel *)*/
1464 /* conflict
1465  | TOCro const_expr TCCro initialize2
1466      { InitIndexOld ($2, $4),    [$1;$3] }
1467 */
1468
1469
1470
1471 /*(* they can be nested, can have a .x[3].y *)*/
1472 designator:
1473  | TDot ident
1474      { DesignatorField (fst $2), [$1;snd $2] }
1475  | TOCro const_expr TCCro
1476      { DesignatorIndex ($2),  [$1;$3] }
1477  | TOCro const_expr TEllipsis const_expr TCCro
1478      { DesignatorRange ($2, $4),  [$1;$3;$5] }
1479
1480
1481 /*(*----------------------------*)*/
1482 /*(* workarounds *)*/
1483 /*(*----------------------------*)*/
1484
1485 gcc_comma_opt_struct:
1486  | TComma {  [$1] }
1487  | /*(* empty *)*/  {  [Ast_c.fakeInfo() +> Ast_c.rewrap_str ","]  }
1488
1489
1490
1491
1492
1493
1494
1495
1496 /*(*************************************************************************)*/
1497 /*(* struct *)*/
1498 /*(*************************************************************************)*/
1499
1500 s_or_u_spec2:
1501  | struct_or_union ident tobrace_struct struct_decl_list_gcc tcbrace_struct
1502      { StructUnion (fst $1, Some (fst $2), $4),  [snd $1;snd $2;$3;$5]  }
1503  | struct_or_union       tobrace_struct struct_decl_list_gcc tcbrace_struct
1504      { StructUnion (fst $1, None, $3), [snd $1;$2;$4] }
1505  | struct_or_union ident
1506      { StructUnionName (fst $1, fst $2), [snd $1;snd $2] }
1507
1508 struct_or_union2:
1509  | Tstruct   { Struct, $1 }
1510  | Tunion    { Union, $1 }
1511  /*(* gccext: *)*/
1512  | Tstruct attributes   { Struct, $1 (* TODO *) }
1513  | Tunion  attributes   { Union, $1  (* TODO *) }
1514
1515
1516
1517 struct_decl2:
1518  | field_declaration { DeclarationField $1 }
1519  | TPtVirg { EmptyField $1  }
1520
1521  /*(* no conflict ? no need for a TMacroStruct ? apparently not as at struct
1522     * the rule are slightly different.
1523     *)*/
1524  | identifier TOPar argument_list TCPar TPtVirg
1525      { MacroDeclField ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]) }
1526
1527  /*(* cppext: *)*/
1528  | cpp_directive
1529      { CppDirectiveStruct $1 }
1530  | cpp_ifdef_directive/*(* struct_decl_list ... *)*/
1531      { IfdefStruct $1 }
1532
1533
1534 field_declaration:
1535  | spec_qualif_list struct_declarator_list TPtVirg
1536      {
1537        let (returnType,storage) = fixDeclSpecForDecl $1 in
1538        if fst (unwrap storage) <> NoSto
1539        then internal_error "parsing dont allow this";
1540
1541        FieldDeclList ($2 +> (List.map (fun (f, iivirg) ->
1542          f returnType, iivirg))
1543                          ,[$3])
1544          (* dont need to check if typedef or func initialised cos
1545           * grammar dont allow typedef nor initialiser in struct
1546           *)
1547      }
1548
1549  |  spec_qualif_list TPtVirg
1550      {
1551        (* gccext: allow empty elements if it is a structdef or enumdef *)
1552        let (returnType,storage) = fixDeclSpecForDecl $1 in
1553        if fst (unwrap storage) <> NoSto
1554        then internal_error "parsing dont allow this";
1555
1556        FieldDeclList ([(Simple (None, returnType)) , []], [$2])
1557      }
1558
1559
1560
1561
1562
1563 struct_declarator:
1564  | declaratorsd
1565      { (fun x -> Simple   (Some (fst $1), (snd $1) x)) }
1566  | dotdot const_expr2
1567      { (fun x -> BitField (None, x, $1, $2)) }
1568  | declaratorsd dotdot const_expr2
1569      { (fun x -> BitField (Some (fst $1), ((snd $1) x), $2, $3)) }
1570
1571
1572 /*(*----------------------------*)*/
1573 /*(* workarounds *)*/
1574 /*(*----------------------------*)*/
1575 declaratorsd:
1576  | declarator { (*also ? LP.add_ident (fst (fst $1)); *) $1 }
1577  /*(* gccext: *)*/
1578  | attributes declarator   { $2 }
1579  | declarator attributes   { $1 }
1580
1581
1582
1583
1584 struct_or_union_spec: s_or_u_spec2 { dt "su" (); $1 }
1585 struct_or_union: struct_or_union2 { et "su" (); $1 }
1586 struct_decl: struct_decl2  { et "struct" (); $1 }
1587
1588 dotdot: TDotDot  { et "dotdot" (); $1 }
1589 const_expr2: const_expr { dt "const_expr2" (); $1 }
1590
1591 struct_decl_list_gcc:
1592  | struct_decl_list  { $1 }
1593  | /*(* empty *)*/       { [] } /*(* gccext: allow empty struct *)*/
1594
1595
1596 /*(*************************************************************************)*/
1597 /*(* enum *)*/
1598 /*(*************************************************************************)*/
1599 enum_spec:
1600  | Tenum        tobrace_enum enumerator_list gcc_comma_opt_struct tcbrace_enum
1601      { Enum (None,    $3),           [$1;$2;$5] ++ $4 }
1602  | Tenum ident  tobrace_enum enumerator_list gcc_comma_opt_struct tcbrace_enum
1603      { Enum (Some (fst $2), $4),     [$1; snd $2; $3;$6] ++ $5 }
1604  | Tenum ident
1605      { EnumName (fst $2),       [$1; snd $2] }
1606
1607 enumerator:
1608  | idente                 { $1, None     }
1609  | idente  TEq const_expr { $1, Some ($2, $3) }
1610
1611
1612 /*(*----------------------------*)*/
1613 /*(* workarounds *)*/
1614 /*(*----------------------------*)*/
1615
1616 idente: ident_cpp { LP.add_ident (str_of_name $1); $1 }
1617
1618
1619
1620 /*(*************************************************************************)*/
1621 /*(* function *)*/
1622 /*(*************************************************************************)*/
1623 function_definition: function_def    { fixFunc $1 }
1624
1625 decl_list:
1626  | decl           { [$1 Ast_c.LocalDecl]   }
1627  | decl_list decl { $1 ++ [$2 Ast_c.LocalDecl] }
1628
1629 /* hack : to drop when a better solution is found */
1630 cpp_directive_list:
1631  | cpp_directive                    { }
1632  | cpp_directive_list cpp_directive { }
1633
1634 function_def:
1635  | start_fun compound      { LP.del_scope(); ($1, $2, None) }
1636  | start_fun cpp_directive_list compound { LP.del_scope(); ($1, $3, None) }
1637  | start_fun decl_list compound      {
1638      (* TODO: undo the typedef added ? *)
1639      LP.del_scope();
1640      ($1, $3, Some $2)
1641    }
1642
1643 start_fun: start_fun2
1644   { LP.new_scope();
1645     fix_add_params_ident $1;
1646     (* toreput? !LP._lexer_hint.toplevel <- false;  *)
1647     $1
1648   }
1649
1650 start_fun2: decl_spec declaratorfd
1651      { let (returnType,storage) = fixDeclSpecForFuncDef $1 in
1652        let (id, attrs) = $2 in
1653        (fst id, fixOldCDecl ((snd id) returnType) , storage, attrs)
1654      }
1655    | ctor_dtor { $1 }
1656
1657 ctor_dtor:
1658  | Tconstructorname topar tcpar {
1659      let id = RegularName (mk_string_wrap $1) in
1660      let ret = mk_ty NoType [] in
1661      let ty = mk_ty (FunctionType (ret, (([], (false, []))))) [$2;$3] in
1662      let storage = ((NoSto,false),[]) in
1663      let attrs = [] in
1664      (id, ty, storage, attrs) }
1665  | Tconstructorname topar parameter_type_list tcpar {
1666      let id = RegularName (mk_string_wrap $1) in
1667      let ret = mk_ty NoType [] in
1668      let ty = mk_ty (FunctionType (ret, $3)) [$2;$4] in
1669      let storage = ((NoSto,false),[]) in
1670      let attrs = [] in
1671      (id, ty, storage, attrs) }
1672
1673 /*(*----------------------------*)*/
1674 /*(* workarounds *)*/
1675 /*(*----------------------------*)*/
1676
1677 /* It would be very nice if we could make declarator aware that this is
1678 coming from a function definition.  Then on the ( and ) cases, it could
1679 set the state to something other than InParameter.  Then the case
1680 (TIdent (s, i1)::(TComma _|TCPar _)::_ , (TComma _ |TOPar _)::_ )
1681 in parsing_hacks.ml would not have to consider K&R variable declarations
1682 as typedefs.  Unfortunately, doing something about this problem seems to
1683 introduce conflicts in the parser. */
1684
1685 declaratorfd:
1686  | declarator { et "declaratorfd" (); $1, Ast_c.noattr }
1687  /*(* gccext: *)*/
1688  | attributes declarator   { et "declaratorfd" (); $2, $1 }
1689  | declarator attributes   { et "declaratorfd" (); $1, Ast_c.noattr }
1690
1691
1692
1693 /*(*************************************************************************)*/
1694 /*(* cpp directives *)*/
1695 /*(*************************************************************************)*/
1696
1697 cpp_directive:
1698  | TIncludeStart TIncludeFilename
1699      {
1700        let (i1, in_ifdef) = $1 in
1701        let (s, i2) = $2 in
1702
1703        (* redo some lexing work :( *)
1704        let inc_file =
1705          match () with
1706          | _ when s =~ "^\"\\(.*\\)\"$" ->
1707              Local (Common.split "/" (matched1 s))
1708          | _ when s =~ "^\\<\\(.*\\)\\>$" ->
1709              NonLocal (Common.split "/" (matched1 s))
1710          | _ ->
1711              Weird s
1712        in
1713        Include { i_include = (inc_file, [i1;i2]);
1714                  i_rel_pos = Ast_c.noRelPos();
1715                  i_is_in_ifdef = !in_ifdef;
1716                  i_content = Ast_c.noi_content;
1717        }
1718      }
1719
1720  | TDefine TIdentDefine define_val TDefEOL
1721      { Define ((fst $2, [$1; snd $2;$4]), (DefineVar, $3)) }
1722
1723  /*
1724  (* The TOParDefine is introduced to avoid ambiguity with previous rules.
1725   * A TOParDefine is a TOPar that was just next to the ident.
1726   *)*/
1727  | TDefine TIdentDefine TOParDefine param_define_list TCPar define_val TDefEOL
1728      { Define
1729          ((fst $2, [$1; snd $2; $7]),
1730            (DefineFunc ($4, [$3;$5]), $6))
1731      }
1732
1733  | TUndef TIdentDefine TDefEOL
1734      { Define((fst $2, [$1; snd $2; $3]), (Undef,DefineEmpty)) }
1735  | TCppDirectiveOther { PragmaAndCo ([$1]) }
1736
1737
1738
1739
1740
1741 /*(* perhaps better to use assign_expr ? but in that case need
1742    * do a assign_expr_of_string in parse_c
1743    *)*/
1744 define_val:
1745  | expr      { DefineExpr $1 }
1746  | statement { DefineStmt $1 }
1747  | decl      { DefineStmt (mk_st (Decl ($1 Ast_c.NotLocalDecl)) Ast_c.noii) }
1748
1749 /*(*old:
1750   * | TypedefIdent { DefineType (nQ,(TypeName(fst $1,noTypedefDef()),[snd $1]))}
1751   * get conflicts:
1752   * | spec_qualif_list TMul
1753   *   { let (returnType, _) = fixDeclSpecForDecl $1 in  DefineType returnType }
1754   *)
1755 */
1756  | decl_spec
1757      { let returnType = fixDeclSpecForMacro $1 in
1758        DefineType returnType
1759      }
1760  | decl_spec abstract_declarator
1761      { let returnType = fixDeclSpecForMacro $1 in
1762        let typ = $2 returnType in
1763        DefineType typ
1764      }
1765
1766 /* can be in conflict with decl_spec, maybe change fixDeclSpecForMacro
1767  * to also allow storage ?
1768  | storage_class_spec { DefineTodo }
1769  | Tinline { DefineTodo }
1770 */
1771
1772  /*(* a few special cases *)*/
1773  | stat_or_decl stat_or_decl_list { DefineTodo }
1774 /*
1775  | statement statement { DefineTodo }
1776  | decl function_definition { DefineTodo }
1777 */
1778
1779
1780
1781
1782  | function_definition { DefineFunction $1 }
1783
1784  | TOBraceDefineInit initialize_list gcc_comma_opt_struct TCBrace comma_opt
1785     { DefineInit (InitList (List.rev $2), [$1;$4]++$3++$5)  }
1786
1787  /*(* note: had a conflict before when were putting TInt instead of expr *)*/
1788  | Tdo statement Twhile TOPar expr TCPar
1789      {
1790        (* TOREPUT
1791        if fst $5 <> "0"
1792        then pr2 "WEIRD: in macro and have not a while(0)";
1793        *)
1794        DefineDoWhileZero (($2,$5),   [$1;$3;$4;$6])
1795      }
1796
1797  | Tasm TOPar asmbody TCPar              { DefineTodo }
1798  | Tasm Tvolatile TOPar asmbody TCPar    { DefineTodo }
1799
1800  /*(* aliases macro *)*/
1801  | TMacroAttr { DefineTodo }
1802
1803  | /*(* empty *)*/ { DefineEmpty }
1804
1805
1806
1807
1808 param_define:
1809  | TIdent               { mk_string_wrap $1 }
1810  | TypedefIdent         { mk_string_wrap $1 }
1811  | TDefParamVariadic    { mk_string_wrap $1 }
1812  | TEllipsis            { "...", [$1] }
1813  /*(* they reuse keywords :(  *)*/
1814  | Tregister            { "register", [$1] }
1815
1816
1817
1818
1819 cpp_ifdef_directive:
1820  | TIfdef
1821      { let (tag,ii) = $1 in
1822        IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)),  [ii]) }
1823  | TIfdefelse
1824      { let (tag,ii) = $1 in
1825        IfdefDirective ((IfdefElse, IfdefTag (Common.some !tag)), [ii]) }
1826  | TIfdefelif
1827      { let (tag,ii) = $1 in
1828        IfdefDirective ((IfdefElseif, IfdefTag (Common.some !tag)), [ii]) }
1829  | TEndif
1830      { let (tag,ii) = $1 in
1831        IfdefDirective ((IfdefEndif, IfdefTag (Common.some !tag)), [ii]) }
1832
1833  | TIfdefBool
1834      { let (_b, tag,ii) = $1 in
1835        IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
1836  | TIfdefMisc
1837      { let (_b, tag,ii) = $1 in
1838        IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
1839  | TIfdefVersion
1840      { let (_b, tag,ii) = $1 in
1841        IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
1842
1843
1844 /*(* cppext: *)*/
1845 cpp_other:
1846  /*(* no conflict ? no need for a TMacroTop ? apparently not as at toplevel
1847     * the rule are slightly different, they cant be statement and so expr
1848     * at the top, only decl or function definition.
1849     *)*/
1850  | identifier TOPar argument_list TCPar TPtVirg
1851      {
1852        Declaration (MacroDecl ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]))
1853        (* old: MacroTop (fst $1, $3,    [snd $1;$2;$4;$5])  *)
1854      }
1855
1856  /*(* TCParEOL to fix the end-of-stream bug of ocamlyacc *)*/
1857  | identifier TOPar argument_list TCParEOL
1858      { MacroTop (fst $1, $3,    [snd $1;$2;$4;fakeInfo()]) }
1859
1860   /*(* ex: EXPORT_NO_SYMBOLS; *)*/
1861  | identifier TPtVirg { EmptyDef [snd $1;$2] }
1862
1863
1864
1865 /*(*************************************************************************)*/
1866 /*(* celem *)*/
1867 /*(*************************************************************************)*/
1868
1869 external_declaration:
1870  | function_definition               { Definition $1 }
1871  | decl                              { Declaration ($1 Ast_c.NotLocalDecl) }
1872
1873
1874 celem:
1875    | external_declaration                         { $1 }
1876
1877  /*(* cppext: *)*/
1878  | cpp_directive
1879      { CppTop $1 }
1880  | cpp_other
1881      { $1 }
1882  | cpp_ifdef_directive /* (*external_declaration_list ...*)*/
1883      { IfdefTop $1 }
1884
1885  /*(* can have asm declaration at toplevel *)*/
1886  | Tasm TOPar asmbody TCPar TPtVirg             { EmptyDef [$1;$2;$4;$5] }
1887
1888  /*
1889  (* in ~/kernels/src/linux-2.5.2/drivers/isdn/hisax/isdnl3.c sometimes
1890   * the function ends with }; instead of just }
1891   * can also remove this rule and report "parse error" pb to morton
1892   *)*/
1893  | TPtVirg    { EmptyDef [$1] }
1894
1895
1896  | EOF        { FinalDef $1 }
1897
1898
1899
1900
1901 /*(*************************************************************************)*/
1902 /*(* some generic workarounds *)*/
1903 /*(*************************************************************************)*/
1904
1905 tobrace: TOBrace  { LP.push_context LP.InFunction; LP.new_scope (); $1 }
1906 tcbrace: TCBrace  { LP.pop_context();              LP.del_scope (); $1 }
1907
1908 tobrace_enum: TOBrace { LP.push_context LP.InEnum; $1 }
1909 tcbrace_enum: TCBrace { LP.pop_context (); $1 }
1910
1911 tobrace_ini: TOBrace { LP.push_context LP.InInitializer; $1 }
1912 tcbrace_ini: TCBrace { LP.pop_context (); $1 }
1913
1914 tobrace_struct: TOBrace { LP.push_context LP.InStruct; $1}
1915 tcbrace_struct: TCBrace { LP.pop_context (); $1 }
1916
1917
1918
1919
1920 topar: TOPar
1921      { LP.new_scope ();et "topar" ();
1922        LP.push_context LP.InParameter;
1923        $1
1924      }
1925 tcpar: TCPar
1926      { LP.del_scope ();dt "tcpar" ();
1927        LP.pop_context ();
1928        $1
1929      }
1930
1931
1932
1933
1934 /*(*************************************************************************)*/
1935 /*(* xxx_list, xxx_opt *)*/
1936 /*(*************************************************************************)*/
1937
1938
1939 /*(* old:
1940 compound2:
1941  |                            { ([],[]) }
1942  |  statement_list            { ([], $1) }
1943  |  decl_list                 { ($1, []) }
1944  |  decl_list statement_list  { ($1,$2) }
1945
1946 statement_list: stat_or_decl_list { $1 }
1947 *)*/
1948
1949
1950 /*(*
1951 decl_list:
1952  | decl           { [$1]   }
1953  | decl_list decl { $1 ++ [$2] }
1954
1955 statement_list:
1956  | statement { [$1] }
1957  | statement_list statement { $1 ++ [$2] }
1958 *)*/
1959
1960
1961
1962
1963
1964 string_list:
1965  | string_elem { $1 }
1966  | string_list string_elem { $1 ++ $2 }
1967
1968 colon_asm_list:
1969  | colon_asm { [$1] }
1970  | colon_asm_list colon_asm  { $1 ++ [$2] }
1971
1972 colon_option_list:
1973  | colon_option { [$1, []] }
1974  | colon_option_list TComma colon_option { $1 ++ [$3, [$2]] }
1975
1976
1977 argument_list_ne:
1978  | argument_ne                           { [$1, []] }
1979  | argument_list_ne TComma argument { $1 ++ [$3,    [$2]] }
1980
1981 argument_list:
1982  | argument                           { [$1, []] }
1983  | argument_list TComma argument { $1 ++ [$3,    [$2]] }
1984
1985 /*(*
1986 expression_list:
1987  | assign_expr { [$1, []] }
1988  | expression_list TComma assign_expr { $1 ++ [$3,   [$2]] }
1989 *)*/
1990
1991
1992 struct_decl_list:
1993  | struct_decl                   { [$1] }
1994  | struct_decl_list struct_decl  { $1 ++ [$2] }
1995
1996
1997 struct_declarator_list:
1998  | struct_declarator                               { [$1,           []] }
1999  | struct_declarator_list TComma struct_declarator { $1 ++ [$3,     [$2]] }
2000
2001
2002 enumerator_list:
2003  | enumerator                        { [$1,          []]   }
2004  | enumerator_list TComma enumerator { $1 ++ [$3,    [$2]] }
2005
2006
2007 init_declarator_list:
2008  | init_declarator                             { [$1,   []] }
2009  | init_declarator_list TComma init_declarator { $1 ++ [$3,     [$2]] }
2010
2011
2012 parameter_list:
2013  | parameter_decl                       { [$1, []] }
2014  | parameter_list TComma parameter_decl { $1 ++ [$3,  [$2]] }
2015
2016 taction_list_ne:
2017  | TAction                 { [$1] }
2018  | TAction taction_list_ne { $1 :: $2 }
2019
2020 taction_list:
2021 /*old: was generating conflict, hence now taction_list_ne
2022     | (* empty *) { [] }
2023  | TAction { [$1] }
2024  | taction_list TAction { $1 ++ [$2] }
2025 */
2026  |                      { [] }
2027  | TAction taction_list { $1 :: $2 }
2028
2029 param_define_list:
2030  | /*(* empty *)*/ { [] }
2031  | param_define                           { [$1, []] }
2032  | param_define_list TComma param_define  { $1 ++ [$3, [$2]] }
2033
2034 designator_list:
2035  | designator { [$1] }
2036  | designator_list designator { $1 ++ [$2] }
2037
2038 attribute_list:
2039  | attribute { [$1] }
2040  | attribute_list attribute { $1 ++ [$2] }
2041
2042 attribute_storage_list:
2043  | attribute_storage { [$1] }
2044  | attribute_storage_list attribute_storage { $1 ++ [$2] }
2045
2046
2047 attributes: attribute_list { $1 }
2048
2049
2050
2051 /*(* gccext:  which allow a trailing ',' in enum, as in perl *)*/
2052 gcc_comma_opt:
2053  | TComma {  [$1] }
2054  | /*(* empty *)*/  {  []  }
2055
2056 comma_opt:
2057  | TComma {  [$1] }
2058  | /*(* empty *)*/  {  []  }
2059
2060 /*(*
2061 gcc_opt_virg:
2062  | TPtVirg { }
2063  |  { }
2064 *)*/
2065
2066 gcc_opt_expr:
2067  | expr        { Some $1 }
2068  | /*(* empty *)*/ { None  }
2069
2070 /*(*
2071 opt_ptvirg:
2072  | TPtVirg { [$1] }
2073  | { [] }
2074 *)*/
2075
2076
2077 expr_opt:
2078  | expr            { Some $1 }
2079  | /*(* empty *)*/ { None }
2080