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 /*(* appears mostly after some fix_xxx in parsing_hack *)*/
 404 %token <string * Ast_c.info> TypedefIdent
 405
 406
 407 /*
 408 (* Some tokens like TOPar and TCPar are used as synchronisation stuff,
 409  * in parsing_hack.ml. So if define special tokens like TOParDefine and
 410  * TCParEOL, then take care to also modify in Token_helpers.
 411  *)
 412 */
 413
 414 %token <Ast_c.info> TOPar TCPar TOBrace TCBrace TOCro TCCro
 415 %token <Ast_c.info> TDot TComma TPtrOp
 416 %token <Ast_c.info> TInc TDec
 417 %token <Ast_c.assignOp * Ast_c.info> TAssign
 418 %token <Ast_c.info> TEq
 419 %token <Ast_c.info> TWhy  TTilde TBang
 420 %token <Ast_c.info> TEllipsis
 421 %token <Ast_c.info> TDotDot
 422
 423 %token <Ast_c.info> TPtVirg
 424 %token <Ast_c.info>
 425        TOrLog TAndLog TOr TXor TAnd  TEqEq TNotEq TInf TSup TInfEq TSupEq
 426        TShl TShr
 427        TPlus TMinus TMul TDiv TMod
 428
 429 %token <Ast_c.info>
 430        Tchar Tshort Tint Tdouble Tfloat Tlong Tunsigned Tsigned Tvoid
 431        Tauto Tregister Textern Tstatic
 432        Ttypedef
 433        Tconst Tvolatile
 434        Tstruct Tunion Tenum
 435        Tbreak Telse Tswitch Tcase Tcontinue Tfor Tdo Tif  Twhile Treturn
 436        Tgoto Tdefault
 437        Tsizeof
 438
 439 /*(* C99 *)*/
 440 %token <Ast_c.info>
 441        Trestrict
 442
 443 /*(*-----------------------------------------*)*/
 444 /*(* gccext: extra tokens *)*/
 445 /*(*-----------------------------------------*)*/
 446 %token <Ast_c.info> Tasm
 447 %token <Ast_c.info> Tattribute
 448 %token <Ast_c.info> TattributeNoarg
 449 %token <Ast_c.info> Tinline
 450 %token <Ast_c.info> Ttypeof
 451
 452 /*(*-----------------------------------------*)*/
 453 /*(* cppext: extra tokens *)*/
 454 /*(*-----------------------------------------*)*/
 455 /*(* coupling with Token_helpers.is_cpp_token *)*/
 456
 457
 458 /*(*---------------*)*/
 459 /*(* define        *)*/
 460 /*(*---------------*)*/
 461
 462 %token <Ast_c.info> TDefine
 463 %token <(string * Ast_c.info)> TDefParamVariadic
 464
 465 /*(* disappear after fix_tokens_define *)*/
 466 %token <Ast_c.info> TCppEscapedNewline
 467
 468 %token <Ast_c.info> TCppConcatOp
 469
 470 /*(* appear    after fix_tokens_define *)*/
 471 %token <Ast_c.info> TOParDefine
 472 %token <Ast_c.info> TOBraceDefineInit
 473
 474 %token <(string * Ast_c.info)> TIdentDefine /*(* same *)*/
 475 %token <Ast_c.info>            TDefEOL      /*(* same *)*/
 476
 477
 478 /*(*---------------*)*/
 479 /*(* include       *)*/
 480 /*(*---------------*)*/
 481
 482
 483 /*(* used only in lexer_c, then transformed in comment or splitted in tokens *)*/
 484 %token <(string * string * bool ref * Ast_c.info)> TInclude
 485
 486 /*(* tokens coming from above, generated in parse_c from TInclude, etc *)*/
 487 %token <(Ast_c.info * bool ref)> TIncludeStart
 488 %token <(string * Ast_c.info)> TIncludeFilename
 489
 490
 491 /*(*---------------*)*/
 492 /*(* ifdef         *)*/
 493 /*(*---------------*)*/
 494
 495 /*(* coupling: Token_helpers.is_cpp_instruction *)*/
 496 %token <((int * int) option ref * Ast_c.info)>
 497   TIfdef TIfdefelse TIfdefelif TEndif
 498 %token <(bool * (int * int) option ref * Ast_c.info)>
 499   TIfdefBool TIfdefMisc TIfdefVersion
 500
 501 /*(*---------------*)*/
 502 /*(* other         *)*/
 503 /*(*---------------*)*/
 504
 505
 506 %token <string * Ast_c.info> TUndef
 507
 508 %token <Ast_c.info> TCppDirectiveOther
 509
 510 /*(*---------------*)*/
 511 /*(* macro use     *)*/
 512 /*(*---------------*)*/
 513
 514 /*(* appear  after fix_tokens_cpp, cf also parsing_hacks#hint *)*/
 515
 516 %token <(string * Ast_c.info)>            TMacroAttr
 517 %token <(string * Ast_c.info)>            TMacroStmt
 518 %token <(string * Ast_c.info)> TMacroIdentBuilder
 519 /*(* no need value for the moment *)*/
 520 %token <(string * Ast_c.info)>            TMacroString
 521 %token <(string * Ast_c.info)> TMacroDecl
 522 %token <Ast_c.info>            TMacroDeclConst
 523
 524 %token <(string * Ast_c.info)> TMacroIterator
 525 /*(*
 526 %token <(string * Ast_c.info)> TMacroTop
 527 %token <(string * Ast_c.info)> TMacroStructDecl
 528 *)*/
 529
 530 %token <(string * Ast_c.info)>            TMacroAttrStorage
 531
 532
 533 /*(*---------------*)*/
 534 /*(* other         *)*/
 535 /*(*---------------*)*/
 536
 537
 538 /*(* should disappear after parsing_hack *)*/
 539 %token <Ast_c.info> TCommentSkipTagStart TCommentSkipTagEnd
 540
 541
 542 /*(* appear after parsing_hack *)*/
 543 %token <Ast_c.info> TCParEOL
 544
 545 %token <Ast_c.info> TAction
 546
 547
 548 /*(* TCommentMisc still useful ? obsolete ? *)*/
 549 %token <Ast_c.info> TCommentMisc
 550 %token <(Token_c.cppcommentkind * Ast_c.info)> TCommentCpp
 551
 552
 553 /*(*-----------------------------------------*)*/
 554 %token <Ast_c.info> EOF
 555
 556 /*(*-----------------------------------------*)*/
 557
 558 /*(* must be at the top so that it has the lowest priority *)*/
 559 %nonassoc SHIFTHERE
 560
 561 %nonassoc Telse
 562
 563 %left TOrLog
 564 %left TAndLog
 565 %left TOr
 566 %left TXor
 567 %left TAnd
 568 %left TEqEq TNotEq
 569 %left TInf TSup TInfEq TSupEq
 570 %left TShl TShr
 571 %left TPlus TMinus
 572 %left TMul TDiv TMod
 573
 574 /*(*************************************************************************)*/
 575 /*(* Rules type declaration *)*/
 576 /*(*************************************************************************)*/
 577
 578 %start main celem statement expr type_name
 579 %type <Ast_c.program> main
 580 %type <Ast_c.toplevel> celem
 581
 582 %type <Ast_c.statement> statement
 583 %type <Ast_c.expression> expr
 584 %type <Ast_c.fullType> type_name
 585
 586 %%
 587 /*(*************************************************************************)*/
 588 /*
 589 (* TOC:
 590  * toplevel (obsolete)
 591  *
 592  * ident
 593  * expression
 594  * statement
 595  * types with
 596  *   - left part (type_spec, qualif),
 597  *   - right part (declarator, abstract declarator)
 598  *   - aux part (parameters)
 599  * declaration, storage, initializers
 600  * struct
 601  * enum
 602  * cpp directives
 603  * celem (=~ main)
 604  *
 605  * generic workarounds (obrace, cbrace for context setting)
 606  * xxx_list, xxx_opt
 607  *)
 608 */
 609 /*(*************************************************************************)*/
 610
 611 /*(*************************************************************************)*/
 612 /*(* toplevel *)*/
 613 /*(*************************************************************************)*/
 614 /*(* no more used; now that use error recovery *)*/
 615
 616 main:  translation_unit EOF     { $1 }
 617
 618 translation_unit:
 619  | external_declaration
 620      { !LP._lexer_hint.context_stack <- [LP.InTopLevel];   [$1] }
 621  | translation_unit external_declaration
 622      { !LP._lexer_hint.context_stack <- [LP.InTopLevel]; $1 ++ [$2] }
 623
 624
 625
 626 /*(*************************************************************************)*/
 627 /*(* ident *)*/
 628 /*(*************************************************************************)*/
 629
 630 /*(* Why this ? Why not s/ident/TIdent ? cos there is multiple namespaces in C,
 631    * so a label can have the same name that a typedef, same for field and tags
 632    * hence sometimes the use of ident  instead of TIdent.
 633    *)*/
 634 ident:
 635  | TIdent       { $1 }
 636  | TypedefIdent { $1 }
 637
 638
 639 identifier:
 640  | TIdent       { $1 }
 641
 642 /*
 643 (* cppext: string concatenation of idents
 644  * also cppext: gccext: ##args for variadic macro
 645  *)
 646 */
 647 identifier_cpp:
 648  | TIdent
 649      { RegularName (mk_string_wrap $1) }
 650  | ident_extra_cpp { $1 }
 651
 652 ident_cpp:
 653  | TIdent
 654      { RegularName (mk_string_wrap $1) }
 655  | TypedefIdent
 656      { RegularName (mk_string_wrap $1) }
 657  | ident_extra_cpp { $1 }
 658
 659 ident_extra_cpp:
 660  | TIdent TCppConcatOp identifier_cpp_list
 661      {
 662        CppConcatenatedName (
 663          match $3 with
 664          | [] -> raise Impossible
 665          | (x,concatnull)::xs ->
 666              assert(null concatnull);
 667              (mk_string_wrap $1, [])::(x,[$2])::xs
 668        )
 669    }
 670  | TCppConcatOp TIdent
 671      { CppVariadicName (fst $2, [$1; snd $2]) }
 672  | TMacroIdentBuilder TOPar param_define_list TCPar
 673      { CppIdentBuilder ((fst $1, [snd $1;$2;$4]), $3) }
 674
 675 identifier_cpp_list:
 676  | TIdent { [mk_string_wrap $1, []] }
 677  | identifier_cpp_list TCppConcatOp TIdent { $1 ++ [mk_string_wrap $3, [$2]] }
 678
 679 /*(*************************************************************************)*/
 680 /*(* expr *)*/
 681 /*(*************************************************************************)*/
 682
 683 expr:
 684  | assign_expr             { $1 }
 685  | expr TComma assign_expr { mk_e (Sequence ($1,$3)) [$2] }
 686
 687 /*(* bugfix: in C grammar they put unary_expr, but in fact it must be
 688    * cast_expr, otherwise (int * ) xxx = &yy; is not allowed
 689    *)*/
 690 assign_expr:
 691  | cond_expr                     { $1 }
 692  | cast_expr TAssign assign_expr { mk_e(Assignment ($1,fst $2,$3)) [snd $2]}
 693  | cast_expr TEq     assign_expr { mk_e(Assignment ($1,SimpleAssign,$3)) [$2]}
 694
 695 /*(* gccext: allow optional then part hence gcc_opt_expr
 696    * bugfix: in C grammar they put TDotDot cond_expr, but in fact it must be
 697    * assign_expr, otherwise   pnp ? x : x = 0x388  is not allowed
 698    *)*/
 699 cond_expr:
 700  | arith_expr
 701      { $1 }
 702  | arith_expr TWhy gcc_opt_expr TDotDot assign_expr
 703      { mk_e (CondExpr ($1,$3,$5)) [$2;$4] }
 704
 705
 706 arith_expr:
 707  | cast_expr                     { $1 }
 708  | arith_expr TMul    arith_expr { mk_e(Binary ($1, Arith Mul,      $3)) [$2] }
 709  | arith_expr TDiv    arith_expr { mk_e(Binary ($1, Arith Div,      $3)) [$2] }
 710  | arith_expr TMod    arith_expr { mk_e(Binary ($1, Arith Mod,      $3)) [$2] }
 711  | arith_expr TPlus   arith_expr { mk_e(Binary ($1, Arith Plus,     $3)) [$2] }
 712  | arith_expr TMinus  arith_expr { mk_e(Binary ($1, Arith Minus,    $3)) [$2] }
 713  | arith_expr TShl    arith_expr { mk_e(Binary ($1, Arith DecLeft,  $3)) [$2] }
 714  | arith_expr TShr    arith_expr { mk_e(Binary ($1, Arith DecRight, $3)) [$2] }
 715  | arith_expr TInf    arith_expr { mk_e(Binary ($1, Logical Inf,    $3)) [$2] }
 716  | arith_expr TSup    arith_expr { mk_e(Binary ($1, Logical Sup,    $3)) [$2] }
 717  | arith_expr TInfEq  arith_expr { mk_e(Binary ($1, Logical InfEq,  $3)) [$2] }
 718  | arith_expr TSupEq  arith_expr { mk_e(Binary ($1, Logical SupEq,  $3)) [$2] }
 719  | arith_expr TEqEq   arith_expr { mk_e(Binary ($1, Logical Eq,     $3)) [$2] }
 720  | arith_expr TNotEq  arith_expr { mk_e(Binary ($1, Logical NotEq,  $3)) [$2] }
 721  | arith_expr TAnd    arith_expr { mk_e(Binary ($1, Arith And,      $3)) [$2] }
 722  | arith_expr TOr     arith_expr { mk_e(Binary ($1, Arith Or,       $3)) [$2] }
 723  | arith_expr TXor    arith_expr { mk_e(Binary ($1, Arith Xor,      $3)) [$2] }
 724  | arith_expr TAndLog arith_expr { mk_e(Binary ($1, Logical AndLog, $3)) [$2] }
 725  | arith_expr TOrLog  arith_expr { mk_e(Binary ($1, Logical OrLog,  $3)) [$2] }
 726
 727 cast_expr:
 728  | unary_expr                        { $1 }
 729  | topar2 type_name tcpar2 cast_expr { mk_e(Cast ($2, $4)) [$1;$3] }
 730
 731 unary_expr:
 732  | postfix_expr                    { $1 }
 733  | TInc unary_expr                 { mk_e(Infix ($2, Inc))    [$1] }
 734  | TDec unary_expr                 { mk_e(Infix ($2, Dec))    [$1] }
 735  | unary_op cast_expr              { mk_e(Unary ($2, fst $1)) [snd $1] }
 736  | Tsizeof unary_expr              { mk_e(SizeOfExpr ($2))    [$1] }
 737  | Tsizeof topar2 type_name tcpar2 { mk_e(SizeOfType ($3))    [$1;$2;$4] }
 738
 739 unary_op:
 740  | TAnd   { GetRef,     $1 }
 741  | TMul   { DeRef,      $1 }
 742  | TPlus  { UnPlus,     $1 }
 743  | TMinus { UnMinus,    $1 }
 744  | TTilde { Tilde,      $1 }
 745  | TBang  { Not,        $1 }
 746  /*(* gccext: have that a lot in old kernel to get address of local label.
 747     * cf gcc manual "local labels as values".
 748     *)*/
 749  | TAndLog { GetRefLabel, $1 }
 750
 751
 752
 753 postfix_expr:
 754  | primary_expr               { $1 }
 755  | postfix_expr TOCro expr TCCro
 756      { mk_e(ArrayAccess ($1, $3)) [$2;$4] }
 757  | postfix_expr TOPar argument_list_ne TCPar
 758      { mk_e(FunCall ($1, $3)) [$2;$4] }
 759  | postfix_expr TOPar  TCPar  { mk_e(FunCall ($1, [])) [$2;$3] }
 760  | postfix_expr TDot   ident_cpp { mk_e(RecordAccess   ($1,$3)) [$2] }
 761  | postfix_expr TPtrOp ident_cpp { mk_e(RecordPtAccess ($1,$3)) [$2] }
 762  | postfix_expr TInc          { mk_e(Postfix ($1, Inc)) [$2] }
 763  | postfix_expr TDec          { mk_e(Postfix ($1, Dec)) [$2] }
 764
 765  /*(* gccext: also called compound literals *)*/
 766  | topar2 type_name tcpar2 TOBrace TCBrace
 767      { mk_e(Constructor ($2, [])) [$1;$3;$4;$5] }
 768  | topar2 type_name tcpar2 TOBrace initialize_list gcc_comma_opt TCBrace
 769      { mk_e(Constructor ($2, List.rev $5)) ([$1;$3;$4;$7] ++ $6) }
 770
 771 primary_expr:
 772  | identifier_cpp  { mk_e(Ident  ($1)) [] }
 773  | TInt
 774     { let (str,(sign,base)) = fst $1 in
 775       mk_e(Constant (Int (str,Si(sign,base)))) [snd $1] }
 776  | TFloat  { mk_e(Constant (Float  (fst $1))) [snd $1] }
 777  | TString { mk_e(Constant (String (fst $1))) [snd $1] }
 778  | TChar   { mk_e(Constant (Char   (fst $1))) [snd $1] }
 779  | TOPar expr TCPar { mk_e(ParenExpr ($2)) [$1;$3] }  /*(* forunparser: *)*/
 780
 781  /*(* gccext: cppext: TODO better ast ? *)*/
 782  | TMacroString { mk_e(Constant (MultiString [fst $1])) [snd $1] }
 783  | string_elem string_list
 784      { mk_e(Constant (MultiString ["TODO: MultiString"])) ($1 ++ $2) }
 785
 786  /*(* gccext: allow statement as expressions via ({ statement }) *)*/
 787  | TOPar compound TCPar  { mk_e(StatementExpr ($2)) [$1;$3] }
 788
 789
 790
 791 /*(*----------------------------*)*/
 792 /*(* cppext: *)*/
 793 /*(*----------------------------*)*/
 794
 795 /*(* cppext: *)*/
 796 /*(* to avoid conflicts have to introduce a _not_empty (ne) version *)*/
 797 argument_ne:
 798  | assign_expr { Left $1 }
 799  | parameter_decl { Right (ArgType $1)  }
 800  | action_higherordermacro_ne { Right (ArgAction $1) }
 801
 802
 803 argument:
 804  | assign_expr { Left $1 }
 805  | parameter_decl { Right (ArgType $1)  }
 806  /*(* had conflicts before, but julia fixed them *)*/
 807  | action_higherordermacro { Right (ArgAction $1) }
 808
 809 action_higherordermacro_ne:
 810  | taction_list_ne
 811      { if null $1
 812        then ActMisc [Ast_c.fakeInfo()]
 813        else ActMisc $1
 814      }
 815
 816
 817 action_higherordermacro:
 818  | taction_list
 819      { if null $1
 820        then ActMisc [Ast_c.fakeInfo()]
 821        else ActMisc $1
 822      }
 823
 824
 825 /*(*----------------------------*)*/
 826 /*(* workarounds *)*/
 827 /*(*----------------------------*)*/
 828
 829 /*(* would like evalInt $1 but require too much info *)*/
 830 const_expr: cond_expr { $1  }
 831
 832
 833 topar2: TOPar { et "topar2" (); $1  }
 834 tcpar2: TCPar { et "tcpar2" (); $1 (*TODO? et ? sure ? c pas dt plutot ? *) }
 835
 836
 837
 838 /*(*************************************************************************)*/
 839 /*(* statement *)*/
 840 /*(*************************************************************************)*/
 841
 842 statement: statement2 { mk_st (fst $1) (snd $1) }
 843
 844 statement2:
 845  | labeled         { Labeled      (fst $1), snd $1 }
 846  | compound        { Compound     (fst $1), snd $1 }
 847  | expr_statement  { ExprStatement(fst $1), snd $1 }
 848  | selection       { Selection    (fst $1), snd $1 ++ [fakeInfo()] }
 849  | iteration       { Iteration    (fst $1), snd $1 ++ [fakeInfo()] }
 850  | jump TPtVirg    { Jump         (fst $1), snd $1 ++ [$2] }
 851
 852  /*(* gccext: *)*/
 853  | Tasm TOPar asmbody TCPar TPtVirg             { Asm $3, [$1;$2;$4;$5] }
 854  | Tasm Tvolatile TOPar asmbody TCPar TPtVirg   { Asm $4, [$1;$2;$3;$5;$6] }
 855
 856  /*(* cppext: *)*/
 857  | TMacroStmt { MacroStmt, [snd $1] }
 858
 859
 860
 861
 862 /*(* note that case 1: case 2: i++;    would be correctly parsed, but with
 863    * a Case  (1, (Case (2, i++)))  :(
 864    *)*/
 865 labeled:
 866  | ident_cpp        TDotDot statement   { Label ($1, $3),  [$2] }
 867  | Tcase const_expr TDotDot statement   { Case ($2, $4),       [$1; $3] }
 868  | Tcase const_expr TEllipsis const_expr TDotDot statement
 869      { CaseRange ($2, $4, $6), [$1;$3;$5] } /*(* gccext: allow range *)*/
 870  | Tdefault         TDotDot statement   { Default $3,             [$1; $2] }
 871
 872 end_labeled:
 873  /*(* gccext:  allow toto: }
 874     * was generating each 30 shift/Reduce conflicts,
 875     * mais ca va, ca fait ce qu'il faut.
 876     * update: julia fixed the problem by introducing end_labeled
 877     * and modifying below stat_or_decl_list
 878     *)*/
 879  | ident_cpp            TDotDot
 880      { Label ($1, (mk_st (ExprStatement None) Ast_c.noii)), [$2] }
 881  | Tcase const_expr TDotDot
 882      { Case ($2, (mk_st (ExprStatement None) Ast_c.noii)), [$1;$3] }
 883  | Tdefault         TDotDot
 884      { Default (mk_st (ExprStatement None) Ast_c.noii),    [$1; $2] }
 885
 886
 887
 888
 889
 890 compound: tobrace compound2 tcbrace { $2, [$1; $3]  }
 891
 892
 893 /*
 894 (* cppext: because of cpp, some stuff looks like declaration but are in
 895  * fact statement but too hard to figure out, and if parse them as
 896  * expression, then we force to have first decls and then exprs, then
 897  * will have a parse error. So easier to let mix decl/statement.
 898  * Moreover it helps to not make such a difference between decl and
 899  * statement for further coccinelle phases to factorize code.
 900 *)*/
 901 compound2:
 902  |                   { ([]) }
 903  | stat_or_decl_list { $1 }
 904
 905
 906 stat_or_decl_list:
 907  | stat_or_decl                   { [$1] }
 908  /*(* gccext: to avoid conflicts, cf end_labeled above *)*/
 909  | end_labeled  { [StmtElem (mk_st (Labeled  (fst $1)) (snd $1))] }
 910  /*(* old: conflicts | stat_or_decl_list stat_or_decl { $1 ++ [$2] } *)*/
 911  | stat_or_decl stat_or_decl_list { $1 :: $2 }
 912
 913 stat_or_decl:
 914  | decl      { StmtElem (mk_st (Decl ($1 Ast_c.LocalDecl)) Ast_c.noii) }
 915  | statement { StmtElem $1 }
 916
 917   /*(* gccext: *)*/
 918  | function_definition { StmtElem (mk_st (NestedFunc $1) Ast_c.noii) }
 919
 920  /* (* cppext: *)*/
 921  | cpp_directive
 922      { CppDirectiveStmt $1 }
 923  | cpp_ifdef_directive/*(* stat_or_decl_list ...*)*/
 924      { IfdefStmt $1 }
 925
 926
 927
 928
 929
 930 expr_statement:
 931  | TPtVirg      { None,    [$1] }
 932  | expr TPtVirg { Some $1, [$2] }
 933
 934 selection:
 935  | Tif TOPar expr TCPar statement              %prec SHIFTHERE
 936      { If ($3, $5, (mk_st (ExprStatement None) Ast_c.noii)),   [$1;$2;$4] }
 937  | Tif TOPar expr TCPar statement Telse statement
 938      { If ($3, $5, $7),  [$1;$2;$4;$6] }
 939  | Tswitch TOPar expr TCPar statement
 940      { Switch ($3,$5),   [$1;$2;$4]  }
 941
 942 iteration:
 943  | Twhile TOPar expr TCPar statement
 944      { While ($3,$5),                [$1;$2;$4] }
 945  | Tdo statement Twhile TOPar expr TCPar TPtVirg
 946      { DoWhile ($2,$5),              [$1;$3;$4;$6;$7] }
 947  | Tfor TOPar expr_statement expr_statement TCPar statement
 948      { For ($3,$4,(None, []),$6),    [$1;$2;$5]}
 949  | Tfor TOPar expr_statement expr_statement expr TCPar statement
 950      { For ($3,$4,(Some $5, []),$7), [$1;$2;$6] }
 951  /*(* c++ext: for(int i = 0; i < n; i++)*)*/
 952  | Tfor TOPar decl expr_statement expr_opt TCPar statement
 953      {
 954        (* pr2 "DECL in for"; *)
 955        MacroIteration ("toto", [], $7),[$1;$2;$6] (* TODOfake ast, TODO need decl2 ? *)
 956      }
 957  /*(* cppext: *)*/
 958  | TMacroIterator TOPar argument_list_ne TCPar statement
 959      { MacroIteration (fst $1, $3, $5), [snd $1;$2;$4] }
 960  | TMacroIterator TOPar TCPar statement
 961      { MacroIteration (fst $1, [], $4), [snd $1;$2;$3] }
 962
 963 /*(* the ';' in the caller grammar rule will be appended to the infos *)*/
 964 jump:
 965  | Tgoto ident_cpp  { Goto ($2),  [$1] }
 966  | Tcontinue    { Continue,       [$1] }
 967  | Tbreak       { Break,          [$1] }
 968  | Treturn      { Return,         [$1] }
 969  | Treturn expr { ReturnExpr $2,  [$1] }
 970  | Tgoto TMul expr { GotoComputed $3, [$1;$2] }
 971
 972
 973
 974 /*(*----------------------------*)*/
 975 /*(* gccext: *)*/
 976 /*(*----------------------------*)*/
 977 string_elem:
 978  | TString { [snd $1] }
 979  /*(* cppext:  ex= printk (KERN_INFO "xxx" UTS_RELEASE)  *)*/
 980  | TMacroString { [snd $1] }
 981
 982
 983 asmbody:
 984  | string_list colon_asm_list  { $1, $2 }
 985  | string_list { $1, [] } /*(* in old kernel *)*/
 986
 987
 988 colon_asm: TDotDot colon_option_list { Colon $2, [$1]   }
 989
 990 colon_option:
 991  | TString                      { ColonMisc, [snd $1] }
 992  | TString TOPar asm_expr TCPar { ColonExpr $3, [snd $1; $2;$4] }
 993  /*(* cppext: certainly a macro *)*/
 994  | TOCro identifier TCCro TString TOPar asm_expr TCPar
 995      { ColonExpr $6, [$1;snd $2;$3;snd $4; $5; $7 ] }
 996  | identifier                       { ColonMisc, [snd $1] }
 997  | /*(* empty *)*/                  { ColonMisc, [] }
 998
 999 asm_expr: assign_expr { $1 }
1000
1001 /*(*************************************************************************)*/
1002 /*(* types *)*/
1003 /*(*************************************************************************)*/
1004
1005
1006 /*(*-----------------------------------------------------------------------*)*/
1007 /*(* Type spec, left part of a type *)*/
1008 /*(*-----------------------------------------------------------------------*)*/
1009 type_spec2:
1010  | Tvoid                { Right3 (BaseType Void),            [$1] }
1011  | Tchar                { Right3 (BaseType (IntType CChar)), [$1]}
1012  | Tint                 { Right3 (BaseType (IntType (Si (Signed,CInt)))), [$1]}
1013  | Tfloat               { Right3 (BaseType (FloatType CFloat)),  [$1]}
1014  | Tdouble              { Right3 (BaseType (FloatType CDouble)), [$1] }
1015  | Tshort               { Middle3 Short,  [$1]}
1016  | Tlong                { Middle3 Long,   [$1]}
1017  | Tsigned              { Left3 Signed,   [$1]}
1018  | Tunsigned            { Left3 UnSigned, [$1]}
1019  | struct_or_union_spec { Right3 (fst $1), snd $1 }
1020  | enum_spec            { Right3 (fst $1), snd $1 }
1021
1022  /*
1023  (* parse_typedef_fix1: cant put: TIdent {} cos it make the grammar
1024   * ambiguous, generates lots of conflicts => we must
1025   * use some tricks: we make the lexer and parser cooperate, cf lexerParser.ml.
1026   *
1027   * parse_typedef_fix2: this is not enough, and you must use
1028   * parse_typedef_fix2 to fully manage typedef problems in grammar.
1029   *
1030   * parse_typedef_fix3:
1031   *
1032   * parse_typedef_fix4: try also to do now some consistency checking in
1033   * Parse_c
1034   *)*/
1035  | TypedefIdent
1036      { let name = RegularName (mk_string_wrap $1) in
1037        Right3 (TypeName (name, Ast_c.noTypedefDef())),[] }
1038
1039  | Ttypeof TOPar assign_expr TCPar { Right3 (TypeOfExpr ($3)), [$1;$2;$4] }
1040  | Ttypeof TOPar type_name   TCPar { Right3 (TypeOfType ($3)), [$1;$2;$4] }
1041
1042 /*(*----------------------------*)*/
1043 /*(* workarounds *)*/
1044 /*(*----------------------------*)*/
1045
1046 type_spec: type_spec2    { dt "type" (); $1   }
1047
1048 /*(*-----------------------------------------------------------------------*)*/
1049 /*(* Qualifiers *)*/
1050 /*(*-----------------------------------------------------------------------*)*/
1051
1052 type_qualif:
1053  | Tconst    { {const=true  ; volatile=false}, $1 }
1054  | Tvolatile { {const=false ; volatile=true},  $1 }
1055  /*(* C99 *)*/
1056  | Trestrict { (* TODO *) {const=false ; volatile=false},  $1 }
1057
1058
1059 /*(*-----------------------------------------------------------------------*)*/
1060 /*(* gccext: attributes  *)*/
1061 /*(*-----------------------------------------------------------------------*)*/
1062
1063 attribute:
1064  | Tattribute TOPar /*stuff*/ TCPar { raise Todo }
1065  /*(* cppext: *)*/
1066  | TMacroAttr { Attribute (fst $1), [snd $1] }
1067
1068 attribute_storage:
1069  | TMacroAttrStorage { $1 }
1070
1071 type_qualif_attr:
1072  | type_qualif { $1 }
1073 /*(*TODO !!!!! *)*/
1074  | TMacroAttr { {const=true  ; volatile=false}, snd $1   }
1075
1076 /*(*-----------------------------------------------------------------------*)*/
1077 /*(* Declarator, right part of a type + second part of decl (the ident)  *)*/
1078 /*(*-----------------------------------------------------------------------*)*/
1079
1080 /*
1081 (* declarator return a couple:
1082  *  (name, partial type (a function to be applied to return type))
1083  *
1084  * when int* f(int) we must return Func(Pointer int,int) and not
1085  * Pointer (Func(int,int)
1086  *)*/
1087
1088 declarator:
1089  | pointer direct_d { (fst $2, fun x -> x +> $1 +> (snd $2)  ) }
1090  | direct_d         { $1  }
1091
1092 /*(* so must do  int * const p; if the pointer is constant, not the pointee *)*/
1093 pointer:
1094  | TMul                   { fun x -> mk_ty (Pointer x) [$1] }
1095  | TMul pointer           { fun x -> mk_ty (Pointer ($2 x)) [$1] }
1096  | TMul type_qualif_list
1097      { fun x -> ($2.qualifD, mk_tybis (Pointer x) [$1])}
1098  | TMul type_qualif_list pointer
1099      { fun x -> ($2.qualifD, mk_tybis (Pointer ($3 x)) [$1]) }
1100
1101
1102 direct_d:
1103  | identifier_cpp
1104      { ($1, fun x -> x) }
1105  | TOPar declarator TCPar      /*(* forunparser: old: $2 *)*/
1106      { (fst $2, fun x -> mk_ty (ParenType ((snd $2) x)) [$1;$3]) }
1107  | direct_d tocro            tccro
1108      { (fst $1,fun x->(snd $1) (mk_ty (Array (None,x)) [$2;$3])) }
1109  | direct_d tocro const_expr tccro
1110      { (fst $1,fun x->(snd $1) (mk_ty (Array (Some $3,x)) [$2;$4])) }
1111  | direct_d topar            tcpar
1112      { (fst $1,
1113        fun x->(snd $1)
1114          (mk_ty (FunctionType (x,(([],(false, []))))) [$2;$3]))
1115      }
1116  | direct_d topar parameter_type_list tcpar
1117      { (fst $1,fun x->(snd $1)
1118        (mk_ty (FunctionType (x, $3)) [$2;$4]))
1119      }
1120
1121
1122 /*(*----------------------------*)*/
1123 /*(* workarounds *)*/
1124 /*(*----------------------------*)*/
1125
1126 tocro: TOCro { et "tocro" ();$1 }
1127 tccro: TCCro { dt "tccro" ();$1 }
1128
1129 /*(*-----------------------------------------------------------------------*)*/
1130 abstract_declarator:
1131  | pointer                            { $1 }
1132  |         direct_abstract_declarator { $1 }
1133  | pointer direct_abstract_declarator { fun x -> x +> $2 +> $1 }
1134
1135 direct_abstract_declarator:
1136  | TOPar abstract_declarator TCPar /*(* forunparser: old: $2 *)*/
1137      { fun x -> mk_ty (ParenType ($2 x)) [$1;$3] }
1138
1139  | TOCro            TCCro
1140      { fun x -> mk_ty (Array (None, x)) [$1;$2] }
1141  | TOCro const_expr TCCro
1142      { fun x -> mk_ty (Array (Some $2, x)) [$1;$3] }
1143  | direct_abstract_declarator TOCro            TCCro
1144      { fun x -> $1 (mk_ty (Array (None, x))  [$2;$3]) }
1145  | direct_abstract_declarator TOCro const_expr TCCro
1146      { fun x -> $1 (mk_ty (Array (Some $3,x))  [$2;$4]) }
1147  | TOPar TCPar
1148      { fun x -> mk_ty (FunctionType (x, ([], (false,  [])))) [$1;$2] }
1149  | topar parameter_type_list tcpar
1150      { fun x -> mk_ty (FunctionType (x, $2))  [$1;$3] }
1151 /*(* subtle: here must also use topar, not TOPar, otherwise if have for
1152    * instance   (xxx ( * )(xxx)) cast, then the second xxx may still be a Tident
1153    * but we want to reduce topar, to set the InParameter so that
1154    * parsing_hack can get a chance to change the type of xxx into a typedef.
1155    * That's an example where parsing_hack and the lookahead of ocamlyacc does
1156    * not go very well together ... we got the info too late. We got
1157    * a similar pb with xxx xxx; declaration, cf parsing_hack.ml and the
1158    * "disable typedef cos special case ..." message.
1159 *)*/
1160  | direct_abstract_declarator topar tcpar
1161      { fun x -> $1 (mk_ty (FunctionType (x, (([], (false, []))))) [$2;$3]) }
1162  | direct_abstract_declarator topar parameter_type_list tcpar
1163      { fun x -> $1 (mk_ty (FunctionType (x, $3)) [$2;$4]) }
1164
1165 /*(*-----------------------------------------------------------------------*)*/
1166 /*(* Parameters (use decl_spec not type_spec just for 'register') *)*/
1167 /*(*-----------------------------------------------------------------------*)*/
1168 parameter_type_list:
1169  | parameter_list                  { ($1, (false, []))}
1170  | parameter_list TComma TEllipsis { ($1, (true,  [$2;$3])) }
1171
1172
1173 parameter_decl2:
1174  | decl_spec declaratorp
1175      { let ((returnType,hasreg),iihasreg) = fixDeclSpecForParam $1 in
1176        let (name, ftyp) = $2 in
1177        { p_namei = Some (name);
1178          p_type = ftyp returnType;
1179          p_register = (hasreg, iihasreg);
1180        }
1181      }
1182  | decl_spec abstract_declaratorp
1183      { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1 in
1184        { p_namei = None;
1185          p_type = $2 returnType;
1186          p_register = hasreg, iihasreg;
1187        }
1188      }
1189  | decl_spec
1190      { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1 in
1191        { p_namei = None;
1192          p_type = returnType;
1193          p_register = hasreg, iihasreg;
1194        }
1195      }
1196
1197
1198 /*(*----------------------------*)*/
1199 /*(* workarounds *)*/
1200 /*(*----------------------------*)*/
1201
1202 parameter_decl: parameter_decl2 { et "param" ();  $1 }
1203  | attributes parameter_decl2 { et "param" (); $2 }
1204
1205 declaratorp:
1206  | declarator  { LP.add_ident (str_of_name (fst $1)); $1 }
1207  /*(* gccext: *)*/
1208  | attributes declarator   { LP.add_ident (str_of_name (fst $2)); $2 }
1209  | declarator attributes   { LP.add_ident (str_of_name (fst $1)); $1 }
1210
1211 abstract_declaratorp:
1212  | abstract_declarator { $1 }
1213  /*(* gccext: *)*/
1214  | attributes abstract_declarator { $2 }
1215
1216 /*(*-----------------------------------------------------------------------*)*/
1217 /*(* helper type rules *)*/
1218 /*(*-----------------------------------------------------------------------*)*/
1219
1220 /*(* for struct and also typename *)*/
1221 /*(* cant put decl_spec cos no storage is allowed for field struct *)*/
1222 spec_qualif_list2:
1223  | type_spec                    { addTypeD ($1, nullDecl) }
1224  | type_qualif                  { {nullDecl with qualifD = (fst $1,[snd $1])}}
1225  | type_spec   spec_qualif_list { addTypeD ($1,$2)   }
1226  | type_qualif spec_qualif_list { addQualifD ($1,$2) }
1227
1228 spec_qualif_list: spec_qualif_list2            {  dt "spec_qualif" (); $1 }
1229
1230
1231 /*(* for pointers in direct_declarator and abstract_declarator *)*/
1232 type_qualif_list:
1233  | type_qualif_attr                  { {nullDecl with qualifD = (fst $1,[snd $1])} }
1234  | type_qualif_list type_qualif_attr { addQualifD ($2,$1) }
1235
1236
1237
1238
1239
1240
1241 /*(*-----------------------------------------------------------------------*)*/
1242 /*(* xxx_type_id *)*/
1243 /*(*-----------------------------------------------------------------------*)*/
1244
1245 type_name:
1246  | spec_qualif_list
1247      { let (returnType, _) = fixDeclSpecForDecl $1 in  returnType }
1248  | spec_qualif_list abstract_declaratort
1249      { let (returnType, _) = fixDeclSpecForDecl $1 in $2 returnType }
1250
1251
1252
1253 abstract_declaratort:
1254  | abstract_declarator { $1 }
1255  /*(* gccext: *)*/
1256  | attributes abstract_declarator { $2 }
1257
1258
1259 /*(*************************************************************************)*/
1260 /*(* declaration and initializers *)*/
1261 /*(*************************************************************************)*/
1262
1263 decl2:
1264  | decl_spec TPtVirg
1265      { function local ->
1266        let (returnType,storage) = fixDeclSpecForDecl $1 in
1267        let iistart = Ast_c.fakeInfo () in
1268        DeclList ([{v_namei = None; v_type = returnType;
1269                    v_storage = unwrap storage; v_local = local;
1270                    v_attr = Ast_c.noattr;
1271                    v_type_bis = ref None;
1272                 },[]],
1273                 ($2::iistart::snd storage))
1274      }
1275  | decl_spec init_declarator_list TPtVirg
1276      { function local ->
1277        let (returnType,storage) = fixDeclSpecForDecl $1 in
1278        let iistart = Ast_c.fakeInfo () in
1279        DeclList (
1280          ($2 +> List.map (fun ((((name,f),attrs), ini), iivirg) ->
1281            let s = str_of_name name in
1282            let iniopt =
1283              match ini with
1284              | None -> None
1285              | Some (ini, iini) -> Some (iini, ini)
1286            in
1287            if fst (unwrap storage) =*= StoTypedef
1288            then LP.add_typedef s;
1289            {v_namei = Some (name, iniopt);
1290             v_type = f returnType;
1291             v_storage = unwrap storage;
1292             v_local = local;
1293             v_attr = attrs;
1294             v_type_bis = ref None;
1295            },
1296            iivirg
1297          )
1298          ),  ($3::iistart::snd storage))
1299      }
1300  /*(* cppext: *)*/
1301
1302  | TMacroDecl TOPar argument_list TCPar TPtVirg
1303      { function _ ->
1304        MacroDecl ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]) }
1305  | Tstatic TMacroDecl TOPar argument_list TCPar TPtVirg
1306      { function _ ->
1307        MacroDecl ((fst $2, $4), [snd $2;$3;$5;$6;fakeInfo();$1]) }
1308  | Tstatic TMacroDeclConst TMacroDecl TOPar argument_list TCPar TPtVirg
1309      { function _ ->
1310        MacroDecl ((fst $3, $5), [snd $3;$4;$6;$7;fakeInfo();$1;$2])}
1311
1312
1313 /*(*-----------------------------------------------------------------------*)*/
1314 decl_spec2:
1315  | storage_class_spec      { {nullDecl with storageD = (fst $1, [snd $1]) } }
1316  | type_spec               { addTypeD ($1,nullDecl) }
1317  | type_qualif             { {nullDecl with qualifD  = (fst $1, [snd $1]) } }
1318  | Tinline                 { {nullDecl with inlineD = (true, [$1]) } }
1319  | storage_class_spec decl_spec2 { addStorageD ($1, $2) }
1320  | type_spec          decl_spec2 { addTypeD    ($1, $2) }
1321  | type_qualif        decl_spec2 { addQualifD  ($1, $2) }
1322  | Tinline            decl_spec2 { addInlineD ((true, $1), $2) }
1323
1324 /*(* can simplify by putting all in _opt ? must have at least one otherwise
1325    *  decl_list is ambiguous ? (no cos have ';' between decl)
1326    *)*/
1327
1328
1329 storage_class_spec2:
1330  | Tstatic      { Sto Static,  $1 }
1331  | Textern      { Sto Extern,  $1 }
1332  | Tauto        { Sto Auto,    $1 }
1333  | Tregister    { Sto Register,$1 }
1334  | Ttypedef     { StoTypedef,  $1 }
1335
1336 storage_class_spec:
1337  /*(* gccext: *)*/
1338  | storage_class_spec2 { $1 }
1339  | storage_class_spec2 attribute_storage_list { $1 (* TODO *) }
1340
1341
1342
1343 /*(*----------------------------*)*/
1344 /*(* workarounds *)*/
1345 /*(*----------------------------*)*/
1346
1347 decl:      decl2         { et "decl" (); $1 }
1348 decl_spec: decl_spec2    { dt "declspec" (); $1  }
1349
1350 /*(*-----------------------------------------------------------------------*)*/
1351 /*(* declarators (right part of type and variable) *)*/
1352 /*(*-----------------------------------------------------------------------*)*/
1353 init_declarator2:
1354  | declaratori                  { ($1, None) }
1355  | declaratori teq initialize   { ($1, Some ($3, $2)) }
1356
1357
1358
1359 /*(*----------------------------*)*/
1360 /*(* workarounds *)*/
1361 /*(*----------------------------*)*/
1362 teq: TEq  { et "teq" (); $1 }
1363
1364 init_declarator: init_declarator2  { dt "init" (); $1 }
1365
1366
1367 /*(*----------------------------*)*/
1368 /*(* gccext: *)*/
1369 /*(*----------------------------*)*/
1370
1371 declaratori:
1372  | declarator              { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr }
1373  /*(* gccext: *)*/
1374  | declarator gcc_asm_decl { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr }
1375  /*(* gccext: *)*/
1376  | attributes declarator   { LP.add_ident (str_of_name (fst $2)); $2, $1 }
1377  | declarator attributes   { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr (* TODO *) }
1378
1379
1380
1381 gcc_asm_decl:
1382  | Tasm TOPar asmbody TCPar              {  }
1383  | Tasm Tvolatile TOPar asmbody TCPar   {  }
1384
1385
1386 /*(*-----------------------------------------------------------------------*)*/
1387 initialize:
1388  | assign_expr
1389      { InitExpr $1,                [] }
1390  | tobrace_ini initialize_list gcc_comma_opt_struct  tcbrace_ini
1391      { InitList (List.rev $2),     [$1;$4]++$3 }
1392  | tobrace_ini tcbrace_ini
1393      { InitList [],       [$1;$2] } /*(* gccext: *)*/
1394
1395
1396 /*
1397 (* opti: This time we use the weird order of non-terminal which requires in
1398  * the "caller" to do a List.rev cos quite critical. With this weird order it
1399  * allows yacc to use a constant stack space instead of exploding if we would
1400  * do a  'initialize2 Tcomma initialize_list'.
1401  *)
1402 */
1403 initialize_list:
1404  | initialize2                        { [$1,   []] }
1405  | initialize_list TComma initialize2 { ($3,  [$2])::$1 }
1406
1407
1408 /*(* gccext: condexpr and no assign_expr cos can have ambiguity with comma *)*/
1409 initialize2:
1410  | cond_expr
1411      { InitExpr $1,   [] }
1412  | tobrace_ini initialize_list gcc_comma_opt_struct tcbrace_ini
1413      { InitList (List.rev $2),   [$1;$4]++$3 }
1414  | tobrace_ini tcbrace_ini
1415      { InitList [],  [$1;$2]  }
1416
1417  /*(* gccext: labeled elements, a.k.a designators *)*/
1418  | designator_list TEq initialize2
1419      { InitDesignators ($1, $3), [$2] }
1420
1421  /*(* gccext: old format *)*/
1422  | ident TDotDot initialize2
1423      { InitFieldOld (fst $1, $3),     [snd $1; $2] } /*(* in old kernel *)*/
1424 /* conflict
1425  | TOCro const_expr TCCro initialize2
1426      { InitIndexOld ($2, $4),    [$1;$3] }
1427 */
1428
1429
1430
1431 /*(* they can be nested, can have a .x[3].y *)*/
1432 designator:
1433  | TDot ident
1434      { DesignatorField (fst $2), [$1;snd $2] }
1435  | TOCro const_expr TCCro
1436      { DesignatorIndex ($2),  [$1;$3] }
1437  | TOCro const_expr TEllipsis const_expr TCCro
1438      { DesignatorRange ($2, $4),  [$1;$3;$5] }
1439
1440
1441 /*(*----------------------------*)*/
1442 /*(* workarounds *)*/
1443 /*(*----------------------------*)*/
1444
1445 gcc_comma_opt_struct:
1446  | TComma {  [$1] }
1447  | /*(* empty *)*/  {  [Ast_c.fakeInfo() +> Ast_c.rewrap_str ","]  }
1448
1449
1450
1451
1452
1453
1454
1455
1456 /*(*************************************************************************)*/
1457 /*(* struct *)*/
1458 /*(*************************************************************************)*/
1459
1460 s_or_u_spec2:
1461  | struct_or_union ident tobrace_struct struct_decl_list_gcc tcbrace_struct
1462      { StructUnion (fst $1, Some (fst $2), $4),  [snd $1;snd $2;$3;$5]  }
1463  | struct_or_union       tobrace_struct struct_decl_list_gcc tcbrace_struct
1464      { StructUnion (fst $1, None, $3), [snd $1;$2;$4] }
1465  | struct_or_union ident
1466      { StructUnionName (fst $1, fst $2), [snd $1;snd $2] }
1467
1468 struct_or_union2:
1469  | Tstruct   { Struct, $1 }
1470  | Tunion    { Union, $1 }
1471  /*(* gccext: *)*/
1472  | Tstruct attributes   { Struct, $1 (* TODO *) }
1473  | Tunion  attributes   { Union, $1  (* TODO *) }
1474
1475
1476
1477 struct_decl2:
1478  | field_declaration { DeclarationField $1 }
1479  | TPtVirg { EmptyField $1  }
1480
1481  /*(* no conflict ? no need for a TMacroStruct ? apparently not as at struct
1482     * the rule are slightly different.
1483     *)*/
1484  | identifier TOPar argument_list TCPar TPtVirg
1485      { MacroDeclField ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]) }
1486
1487  /*(* cppext: *)*/
1488  | cpp_directive
1489      { CppDirectiveStruct $1 }
1490  | cpp_ifdef_directive/*(* struct_decl_list ... *)*/
1491      { IfdefStruct $1 }
1492
1493
1494 field_declaration:
1495  | spec_qualif_list struct_declarator_list TPtVirg
1496      {
1497        let (returnType,storage) = fixDeclSpecForDecl $1 in
1498        if fst (unwrap storage) <> NoSto
1499        then internal_error "parsing dont allow this";
1500
1501        FieldDeclList ($2 +> (List.map (fun (f, iivirg) ->
1502          f returnType, iivirg))
1503                          ,[$3])
1504          (* dont need to check if typedef or func initialised cos
1505           * grammar dont allow typedef nor initialiser in struct
1506           *)
1507      }
1508
1509  |  spec_qualif_list TPtVirg
1510      {
1511        (* gccext: allow empty elements if it is a structdef or enumdef *)
1512        let (returnType,storage) = fixDeclSpecForDecl $1 in
1513        if fst (unwrap storage) <> NoSto
1514        then internal_error "parsing dont allow this";
1515
1516        FieldDeclList ([(Simple (None, returnType)) , []], [$2])
1517      }
1518
1519
1520
1521
1522
1523 struct_declarator:
1524  | declaratorsd
1525      { (fun x -> Simple   (Some (fst $1), (snd $1) x)) }
1526  | dotdot const_expr2
1527      { (fun x -> BitField (None, x, $1, $2)) }
1528  | declaratorsd dotdot const_expr2
1529      { (fun x -> BitField (Some (fst $1), ((snd $1) x), $2, $3)) }
1530
1531
1532 /*(*----------------------------*)*/
1533 /*(* workarounds *)*/
1534 /*(*----------------------------*)*/
1535 declaratorsd:
1536  | declarator { (*also ? LP.add_ident (fst (fst $1)); *) $1 }
1537  /*(* gccext: *)*/
1538  | attributes declarator   { $2 }
1539  | declarator attributes   { $1 }
1540
1541
1542
1543
1544 struct_or_union_spec: s_or_u_spec2 { dt "su" (); $1 }
1545 struct_or_union: struct_or_union2 { et "su" (); $1 }
1546 struct_decl: struct_decl2  { et "struct" (); $1 }
1547
1548 dotdot: TDotDot  { et "dotdot" (); $1 }
1549 const_expr2: const_expr { dt "const_expr2" (); $1 }
1550
1551 struct_decl_list_gcc:
1552  | struct_decl_list  { $1 }
1553  | /*(* empty *)*/       { [] } /*(* gccext: allow empty struct *)*/
1554
1555
1556 /*(*************************************************************************)*/
1557 /*(* enum *)*/
1558 /*(*************************************************************************)*/
1559 enum_spec:
1560  | Tenum        tobrace_enum enumerator_list gcc_comma_opt tcbrace_enum
1561      { Enum (None,    $3),           [$1;$2;$5] ++ $4 }
1562  | Tenum ident  tobrace_enum enumerator_list gcc_comma_opt tcbrace_enum
1563      { Enum (Some (fst $2), $4),     [$1; snd $2; $3;$6] ++ $5 }
1564  | Tenum ident
1565      { EnumName (fst $2),       [$1; snd $2] }
1566
1567 enumerator:
1568  | idente                 { $1, None     }
1569  | idente  TEq const_expr { $1, Some ($2, $3) }
1570
1571
1572 /*(*----------------------------*)*/
1573 /*(* workarounds *)*/
1574 /*(*----------------------------*)*/
1575
1576 idente: ident_cpp { LP.add_ident (str_of_name $1); $1 }
1577
1578
1579
1580 /*(*************************************************************************)*/
1581 /*(* function *)*/
1582 /*(*************************************************************************)*/
1583 function_definition: function_def    { fixFunc $1 }
1584
1585 decl_list:
1586  | decl           { [$1 Ast_c.LocalDecl]   }
1587  | decl_list decl { $1 ++ [$2 Ast_c.LocalDecl] }
1588
1589 /* hack : to drop when a better solution is found */
1590 cpp_directive_list:
1591  | cpp_directive                    { }
1592  | cpp_directive_list cpp_directive { }
1593
1594 function_def:
1595  | start_fun compound      { LP.del_scope(); ($1, $2, None) }
1596  | start_fun cpp_directive_list compound { LP.del_scope(); ($1, $3, None) }
1597  | start_fun decl_list compound      {
1598      (* TODO: undo the typedef added ? *)
1599      LP.del_scope();
1600      ($1, $3, Some $2)
1601    }
1602
1603 start_fun: start_fun2
1604   { LP.new_scope();
1605     fix_add_params_ident $1;
1606     (* toreput? !LP._lexer_hint.toplevel <- false;  *)
1607     $1
1608   }
1609
1610 start_fun2: decl_spec declaratorfd
1611      { let (returnType,storage) = fixDeclSpecForFuncDef $1 in
1612        let (id, attrs) = $2 in
1613        (fst id, fixOldCDecl ((snd id) returnType) , storage, attrs)
1614      }
1615
1616 /*(*----------------------------*)*/
1617 /*(* workarounds *)*/
1618 /*(*----------------------------*)*/
1619
1620 declaratorfd:
1621  | declarator { et "declaratorfd" (); $1, Ast_c.noattr }
1622  /*(* gccext: *)*/
1623  | attributes declarator   { et "declaratorfd" (); $2, $1 }
1624  | declarator attributes   { et "declaratorfd" (); $1, Ast_c.noattr }
1625
1626
1627
1628 /*(*************************************************************************)*/
1629 /*(* cpp directives *)*/
1630 /*(*************************************************************************)*/
1631
1632 cpp_directive:
1633  | TIncludeStart TIncludeFilename
1634      {
1635        let (i1, in_ifdef) = $1 in
1636        let (s, i2) = $2 in
1637
1638        (* redo some lexing work :( *)
1639        let inc_file =
1640          match () with
1641          | _ when s =~ "^\"\\(.*\\)\"$" ->
1642              Local (Common.split "/" (matched1 s))
1643          | _ when s =~ "^\\<\\(.*\\)\\>$" ->
1644              NonLocal (Common.split "/" (matched1 s))
1645          | _ ->
1646              Weird s
1647        in
1648        Include { i_include = (inc_file, [i1;i2]);
1649                  i_rel_pos = Ast_c.noRelPos();
1650                  i_is_in_ifdef = !in_ifdef;
1651                  i_content = Ast_c.noi_content;
1652        }
1653      }
1654
1655  | TDefine TIdentDefine define_val TDefEOL
1656      { Define ((fst $2, [$1; snd $2;$4]), (DefineVar, $3)) }
1657
1658  /*
1659  (* The TOParDefine is introduced to avoid ambiguity with previous rules.
1660   * A TOParDefine is a TOPar that was just next to the ident.
1661   *)*/
1662  | TDefine TIdentDefine TOParDefine param_define_list TCPar define_val TDefEOL
1663      { Define
1664          ((fst $2, [$1; snd $2;$7]),
1665            (DefineFunc ($4, [$3;$5]), $6))
1666      }
1667
1668  | TUndef             { Undef (fst $1, [snd $1]) }
1669  | TCppDirectiveOther { PragmaAndCo ([$1]) }
1670
1671
1672
1673
1674
1675 /*(* perhaps better to use assign_expr ? but in that case need
1676    * do a assign_expr_of_string in parse_c
1677    *)*/
1678 define_val:
1679  | expr      { DefineExpr $1 }
1680  | statement { DefineStmt $1 }
1681  | decl      { DefineStmt (mk_st (Decl ($1 Ast_c.NotLocalDecl)) Ast_c.noii) }
1682
1683 /*(*old:
1684   * | TypedefIdent { DefineType (nQ,(TypeName(fst $1,noTypedefDef()),[snd $1]))}
1685   * get conflicts:
1686   * | spec_qualif_list TMul
1687   *   { let (returnType, _) = fixDeclSpecForDecl $1 in  DefineType returnType }
1688   *)
1689 */
1690  | decl_spec
1691      { let returnType = fixDeclSpecForMacro $1 in
1692        DefineType returnType
1693      }
1694  | decl_spec abstract_declarator
1695      { let returnType = fixDeclSpecForMacro $1 in
1696        let typ = $2 returnType in
1697        DefineType typ
1698      }
1699
1700 /* can be in conflict with decl_spec, maybe change fixDeclSpecForMacro
1701  * to also allow storage ?
1702  | storage_class_spec { DefineTodo }
1703  | Tinline { DefineTodo }
1704 */
1705
1706  /*(* a few special cases *)*/
1707  | stat_or_decl stat_or_decl_list { DefineTodo }
1708 /*
1709  | statement statement { DefineTodo }
1710  | decl function_definition { DefineTodo }
1711 */
1712
1713
1714
1715
1716  | function_definition { DefineFunction $1 }
1717
1718  | TOBraceDefineInit initialize_list gcc_comma_opt_struct TCBrace comma_opt
1719     { DefineInit (InitList (List.rev $2), [$1;$4]++$3++$5)  }
1720
1721  /*(* note: had a conflict before when were putting TInt instead of expr *)*/
1722  | Tdo statement Twhile TOPar expr TCPar
1723      {
1724        (* TOREPUT
1725        if fst $5 <> "0"
1726        then pr2 "WEIRD: in macro and have not a while(0)";
1727        *)
1728        DefineDoWhileZero (($2,$5),   [$1;$3;$4;$6])
1729      }
1730
1731  | Tasm TOPar asmbody TCPar              { DefineTodo }
1732  | Tasm Tvolatile TOPar asmbody TCPar    { DefineTodo }
1733
1734  /*(* aliases macro *)*/
1735  | TMacroAttr { DefineTodo }
1736
1737  | /*(* empty *)*/ { DefineEmpty }
1738
1739
1740
1741
1742 param_define:
1743  | TIdent               { mk_string_wrap $1 }
1744  | TypedefIdent         { mk_string_wrap $1 }
1745  | TDefParamVariadic    { mk_string_wrap $1 }
1746  | TEllipsis            { "...", [$1] }
1747  /*(* they reuse keywords :(  *)*/
1748  | Tregister            { "register", [$1] }
1749
1750
1751
1752
1753 cpp_ifdef_directive:
1754  | TIfdef
1755      { let (tag,ii) = $1 in
1756        IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)),  [ii]) }
1757  | TIfdefelse
1758      { let (tag,ii) = $1 in
1759        IfdefDirective ((IfdefElse, IfdefTag (Common.some !tag)), [ii]) }
1760  | TIfdefelif
1761      { let (tag,ii) = $1 in
1762        IfdefDirective ((IfdefElseif, IfdefTag (Common.some !tag)), [ii]) }
1763  | TEndif
1764      { let (tag,ii) = $1 in
1765        IfdefDirective ((IfdefEndif, IfdefTag (Common.some !tag)), [ii]) }
1766
1767  | TIfdefBool
1768      { let (_b, tag,ii) = $1 in
1769        IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
1770  | TIfdefMisc
1771      { let (_b, tag,ii) = $1 in
1772        IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
1773  | TIfdefVersion
1774      { let (_b, tag,ii) = $1 in
1775        IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) }
1776
1777
1778 /*(* cppext: *)*/
1779 cpp_other:
1780  /*(* no conflict ? no need for a TMacroTop ? apparently not as at toplevel
1781     * the rule are slightly different, they cant be statement and so expr
1782     * at the top, only decl or function definition.
1783     *)*/
1784  | identifier TOPar argument_list TCPar TPtVirg
1785      {
1786        Declaration (MacroDecl ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]))
1787        (* old: MacroTop (fst $1, $3,    [snd $1;$2;$4;$5])  *)
1788      }
1789
1790  /*(* TCParEOL to fix the end-of-stream bug of ocamlyacc *)*/
1791  | identifier TOPar argument_list TCParEOL
1792      { MacroTop (fst $1, $3,    [snd $1;$2;$4;fakeInfo()]) }
1793
1794   /*(* ex: EXPORT_NO_SYMBOLS; *)*/
1795  | identifier TPtVirg { EmptyDef [snd $1;$2] }
1796
1797
1798
1799 /*(*************************************************************************)*/
1800 /*(* celem *)*/
1801 /*(*************************************************************************)*/
1802
1803 external_declaration:
1804  | function_definition               { Definition $1 }
1805  | decl                              { Declaration ($1 Ast_c.NotLocalDecl) }
1806
1807
1808 celem:
1809  | external_declaration                         { $1 }
1810
1811  /*(* cppext: *)*/
1812  | cpp_directive
1813      { CppTop $1 }
1814  | cpp_other
1815      { $1 }
1816  | cpp_ifdef_directive /* (*external_declaration_list ...*)*/
1817      { IfdefTop $1 }
1818
1819  /*(* can have asm declaration at toplevel *)*/
1820  | Tasm TOPar asmbody TCPar TPtVirg             { EmptyDef [$1;$2;$4;$5] }
1821
1822  /*
1823  (* in ~/kernels/src/linux-2.5.2/drivers/isdn/hisax/isdnl3.c sometimes
1824   * the function ends with }; instead of just }
1825   * can also remove this rule and report "parse error" pb to morton
1826   *)*/
1827  | TPtVirg    { EmptyDef [$1] }
1828
1829
1830  | EOF        { FinalDef $1 }
1831
1832
1833
1834
1835 /*(*************************************************************************)*/
1836 /*(* some generic workarounds *)*/
1837 /*(*************************************************************************)*/
1838
1839 tobrace: TOBrace  { LP.push_context LP.InFunction; LP.new_scope (); $1 }
1840 tcbrace: TCBrace  { LP.pop_context();              LP.del_scope (); $1 }
1841
1842 tobrace_enum: TOBrace { LP.push_context LP.InEnum; $1 }
1843 tcbrace_enum: TCBrace { LP.pop_context (); $1 }
1844
1845 tobrace_ini: TOBrace { LP.push_context LP.InInitializer; $1 }
1846 tcbrace_ini: TCBrace { LP.pop_context (); $1 }
1847
1848 tobrace_struct: TOBrace { LP.push_context LP.InStruct; $1}
1849 tcbrace_struct: TCBrace { LP.pop_context (); $1 }
1850
1851
1852
1853
1854 topar: TOPar
1855      { LP.new_scope ();et "topar" ();
1856        LP.push_context LP.InParameter;
1857        $1
1858      }
1859 tcpar: TCPar
1860      { LP.del_scope ();dt "tcpar" ();
1861        LP.pop_context ();
1862        $1
1863      }
1864
1865
1866
1867
1868 /*(*************************************************************************)*/
1869 /*(* xxx_list, xxx_opt *)*/
1870 /*(*************************************************************************)*/
1871
1872
1873 /*(* old:
1874 compound2:
1875  |                            { ([],[]) }
1876  |  statement_list            { ([], $1) }
1877  |  decl_list                 { ($1, []) }
1878  |  decl_list statement_list  { ($1,$2) }
1879
1880 statement_list: stat_or_decl_list { $1 }
1881 *)*/
1882
1883
1884 /*(*
1885 decl_list:
1886  | decl           { [$1]   }
1887  | decl_list decl { $1 ++ [$2] }
1888
1889 statement_list:
1890  | statement { [$1] }
1891  | statement_list statement { $1 ++ [$2] }
1892 *)*/
1893
1894
1895
1896
1897
1898 string_list:
1899  | string_elem { $1 }
1900  | string_list string_elem { $1 ++ $2 }
1901
1902 colon_asm_list:
1903  | colon_asm { [$1] }
1904  | colon_asm_list colon_asm  { $1 ++ [$2] }
1905
1906 colon_option_list:
1907  | colon_option { [$1, []] }
1908  | colon_option_list TComma colon_option { $1 ++ [$3, [$2]] }
1909
1910
1911 argument_list_ne:
1912  | argument_ne                           { [$1, []] }
1913  | argument_list_ne TComma argument { $1 ++ [$3,    [$2]] }
1914
1915 argument_list:
1916  | argument                           { [$1, []] }
1917  | argument_list TComma argument { $1 ++ [$3,    [$2]] }
1918
1919 /*(*
1920 expression_list:
1921  | assign_expr { [$1, []] }
1922  | expression_list TComma assign_expr { $1 ++ [$3,   [$2]] }
1923 *)*/
1924
1925
1926 struct_decl_list:
1927  | struct_decl                   { [$1] }
1928  | struct_decl_list struct_decl  { $1 ++ [$2] }
1929
1930
1931 struct_declarator_list:
1932  | struct_declarator                               { [$1,           []] }
1933  | struct_declarator_list TComma struct_declarator { $1 ++ [$3,     [$2]] }
1934
1935
1936 enumerator_list:
1937  | enumerator                        { [$1,          []]   }
1938  | enumerator_list TComma enumerator { $1 ++ [$3,    [$2]] }
1939
1940
1941 init_declarator_list:
1942  | init_declarator                             { [$1,   []] }
1943  | init_declarator_list TComma init_declarator { $1 ++ [$3,     [$2]] }
1944
1945
1946 parameter_list:
1947  | parameter_decl                       { [$1, []] }
1948  | parameter_list TComma parameter_decl { $1 ++ [$3,  [$2]] }
1949
1950 taction_list_ne:
1951  | TAction                 { [$1] }
1952  | TAction taction_list_ne { $1 :: $2 }
1953
1954 taction_list:
1955 /*old: was generating conflict, hence now taction_list_ne
1956     | (* empty *) { [] }
1957  | TAction { [$1] }
1958  | taction_list TAction { $1 ++ [$2] }
1959 */
1960  |                      { [] }
1961  | TAction taction_list { $1 :: $2 }
1962
1963 param_define_list:
1964  | /*(* empty *)*/ { [] }
1965  | param_define                           { [$1, []] }
1966  | param_define_list TComma param_define  { $1 ++ [$3, [$2]] }
1967
1968 designator_list:
1969  | designator { [$1] }
1970  | designator_list designator { $1 ++ [$2] }
1971
1972 attribute_list:
1973  | attribute { [$1] }
1974  | attribute_list attribute { $1 ++ [$2] }
1975
1976 attribute_storage_list:
1977  | attribute_storage { [$1] }
1978  | attribute_storage_list attribute_storage { $1 ++ [$2] }
1979
1980
1981 attributes: attribute_list { $1 }
1982
1983
1984
1985 /*(* gccext:  which allow a trailing ',' in enum, as in perl *)*/
1986 gcc_comma_opt:
1987  | TComma {  [$1] }
1988  | /*(* empty *)*/  {  []  }
1989
1990 comma_opt:
1991  | TComma {  [$1] }
1992  | /*(* empty *)*/  {  []  }
1993
1994 /*(*
1995 gcc_opt_virg:
1996  | TPtVirg { }
1997  |  { }
1998 *)*/
1999
2000 gcc_opt_expr:
2001  | expr        { Some $1 }
2002  | /*(* empty *)*/ { None  }
2003
2004 /*(*
2005 opt_ptvirg:
2006  | TPtVirg { [$1] }
2007  | { [] }
2008 *)*/
2009
2010
2011 expr_opt:
2012  | expr            { Some $1 }
2013  | /*(* empty *)*/ { None }
2014