parsing_cocci/parse_aux.ml

   1 (*
   2  * Copyright 2012, INRIA
   3  * Julia Lawall, Gilles Muller
   4  * Copyright 2010-2011, INRIA, University of Copenhagen
   5  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   6  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   7  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   8  * This file is part of Coccinelle.
   9  *
  10  * Coccinelle is free software: you can redistribute it and/or modify
  11  * it under the terms of the GNU General Public License as published by
  12  * the Free Software Foundation, according to version 2 of the License.
  13  *
  14  * Coccinelle is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  21  *
  22  * The authors reserve the right to distribute this or future versions of
  23  * Coccinelle under other licenses.
  24  *)
  25
  26
  27 # 0 "./parse_aux.ml"
  28 (* exports everything, used only by parser_cocci_menhir.mly *)
  29 module Ast0 = Ast0_cocci
  30 module Ast = Ast_cocci
  31
  32 (* types for metavariable tokens *)
  33 type info = Ast.meta_name * Ast0.pure * Data.clt
  34 type midinfo =
  35     Ast.meta_name * Data.iconstraints * Ast.seed * Ast0.pure * Data.clt
  36 type idinfo = Ast.meta_name * Data.iconstraints * Ast0.pure * Data.clt
  37 type expinfo = Ast.meta_name * Data.econstraints * Ast0.pure * Data.clt
  38 type tyinfo = Ast.meta_name * Ast0.typeC list * Ast0.pure * Data.clt
  39 type list_info = Ast.meta_name * Ast.list_len * Ast0.pure * Data.clt
  40 type typed_expinfo =
  41     Ast.meta_name * Data.econstraints * Ast0.pure *
  42       Type_cocci.typeC list option * Data.clt
  43 type pos_info = Ast.meta_name * Data.pconstraints * Ast.meta_collect * Data.clt
  44
  45 let get_option fn = function
  46     None -> None
  47   | Some x -> Some (fn x)
  48
  49 let make_info line logical_line offset col strbef straft isSymbol =
  50   let new_pos_info =
  51     {Ast0.line_start = line; Ast0.line_end = line;
  52       Ast0.logical_start = logical_line; Ast0.logical_end = logical_line;
  53       Ast0.column = col; Ast0.offset = offset; } in
  54   { Ast0.pos_info = new_pos_info;
  55     Ast0.attachable_start = true; Ast0.attachable_end = true;
  56     Ast0.mcode_start = []; Ast0.mcode_end = [];
  57     Ast0.strings_before = strbef; Ast0.strings_after = straft;
  58     Ast0.isSymbolIdent = isSymbol; }
  59
  60 let clt2info (_,line,logical_line,offset,col,strbef,straft,pos) =
  61   make_info line logical_line offset col strbef straft false
  62
  63 let drop_bef (arity,line,lline,offset,col,strbef,straft,pos) =
  64   (arity,line,lline,offset,col,[],straft,pos)
  65
  66 let drop_aft (arity,line,lline,offset,col,strbef,straft,pos) =
  67   (arity,line,lline,offset,col,strbef,[],pos)
  68
  69 (* used for #define, to put aft on ident/( *)
  70 let get_aft (arity,line,lline,offset,col,strbef,straft,pos) = straft
  71
  72 let set_aft aft (arity,line,lline,offset,col,strbef,_,pos) =
  73   (arity,line,lline,offset,col,strbef,aft,pos)
  74
  75 let drop_pos (arity,line,lline,offset,col,strbef,straft,pos) =
  76   (arity,line,lline,offset,col,strbef,straft,[])
  77
  78 let clt2mcode_ext str isSymbol = function
  79     (Data.MINUS,line,lline,offset,col,strbef,straft,pos)       ->
  80       (str,Ast0.NONE,make_info line lline offset col strbef straft isSymbol,
  81        Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)),ref pos,-1)
  82   | (Data.OPTMINUS,line,lline,offset,col,strbef,straft,pos)    ->
  83       (str,Ast0.OPT,make_info line lline offset col strbef straft isSymbol,
  84        Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)),ref pos,-1)
  85   | (Data.UNIQUEMINUS,line,lline,offset,col,strbef,straft,pos) ->
  86       (str,Ast0.UNIQUE,make_info line lline offset col strbef straft isSymbol,
  87        Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)),ref pos,-1)
  88   | (Data.PLUS,line,lline,offset,col,strbef,straft,pos)        ->
  89       (str,Ast0.NONE,make_info line lline offset col strbef straft isSymbol,
  90        Ast0.PLUS(Ast.ONE),ref pos,-1)
  91   | (Data.PLUSPLUS,line,lline,offset,col,strbef,straft,pos)        ->
  92       (str,Ast0.NONE,make_info line lline offset col strbef straft isSymbol,
  93        Ast0.PLUS(Ast.MANY),ref pos,-1)
  94   | (Data.CONTEXT,line,lline,offset,col,strbef,straft,pos)     ->
  95       (str,Ast0.NONE,make_info line lline offset col strbef straft isSymbol,
  96        Ast0.CONTEXT(ref(Ast.NOTHING,
  97                         Ast0.default_token_info,Ast0.default_token_info)),
  98        ref pos,-1)
  99   | (Data.OPT,line,lline,offset,col,strbef,straft,pos)         ->
 100       (str,Ast0.OPT,make_info line lline offset col strbef straft isSymbol,
 101        Ast0.CONTEXT(ref(Ast.NOTHING,
 102                         Ast0.default_token_info,Ast0.default_token_info)),
 103        ref pos,-1)
 104   | (Data.UNIQUE,line,lline,offset,col,strbef,straft,pos)      ->
 105       (str,Ast0.UNIQUE,make_info line lline offset col strbef straft isSymbol,
 106        Ast0.CONTEXT(ref(Ast.NOTHING,
 107                         Ast0.default_token_info,Ast0.default_token_info)),
 108        ref pos,-1)
 109
 110 let clt2mcode name clt = clt2mcode_ext name false clt
 111 let id2name   (name, clt) = name
 112 let id2clt    (name, clt) = clt
 113 let id2mcode  (name, clt) = clt2mcode name clt
 114 let sym2mcode (name, clt) = clt2mcode_ext name true clt
 115
 116 let mkdots str (dot,whencode) =
 117   match str with
 118     "..." -> Ast0.wrap(Ast0.Dots(clt2mcode str dot, whencode))
 119   | "ooo" -> Ast0.wrap(Ast0.Circles(clt2mcode str dot, whencode))
 120   | "***" -> Ast0.wrap(Ast0.Stars(clt2mcode str dot, whencode))
 121   | _ -> failwith "cannot happen"
 122
 123 let mkedots str (dot,whencode) =
 124   match str with
 125     "..." -> Ast0.wrap(Ast0.Edots(clt2mcode str dot, whencode))
 126   | "ooo" -> Ast0.wrap(Ast0.Ecircles(clt2mcode str dot, whencode))
 127   | "***" -> Ast0.wrap(Ast0.Estars(clt2mcode str dot, whencode))
 128   | _ -> failwith "cannot happen"
 129
 130 let mkdpdots str dot =
 131   match str with
 132     "..." -> Ast0.wrap(Ast0.DPdots(clt2mcode str dot))
 133   | "ooo" -> Ast0.wrap(Ast0.DPcircles(clt2mcode str dot))
 134   | _ -> failwith "cannot happen"
 135
 136 let mkidots str (dot,whencode) =
 137   match str with
 138     "..." -> Ast0.wrap(Ast0.Idots(clt2mcode str dot, whencode))
 139   | _ -> failwith "cannot happen"
 140
 141 let mkddots str (dot,whencode) =
 142   match (str,whencode) with
 143     ("...",None) -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, None))
 144   | ("...",Some [w]) -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, Some w))
 145   | _ -> failwith "cannot happen"
 146
 147 let mkddots_one str (dot,whencode) =
 148   match str with
 149     "..." -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, whencode))
 150   | _ -> failwith "cannot happen"
 151
 152 let mkpdots str dot =
 153   match str with
 154     "..." -> Ast0.wrap(Ast0.Pdots(clt2mcode str dot))
 155   | "ooo" -> Ast0.wrap(Ast0.Pcircles(clt2mcode str dot))
 156   | _ -> failwith "cannot happen"
 157
 158 let arith_op ast_op left op right =
 159   Ast0.wrap
 160     (Ast0.Binary(left, clt2mcode (Ast.Arith ast_op) op, right))
 161
 162 let logic_op ast_op left op right =
 163   Ast0.wrap
 164     (Ast0.Binary(left, clt2mcode (Ast.Logical ast_op) op, right))
 165
 166 let make_cv cv ty =
 167   match cv with None -> ty | Some x -> Ast0.wrap (Ast0.ConstVol(x,ty))
 168
 169 let top_dots l =
 170   let circle x =
 171     match Ast0.unwrap x with Ast0.Circles(_) -> true | _ -> false in
 172   let star x =
 173     match Ast0.unwrap x with Ast0.Stars(_) -> true | _ -> false in
 174   if List.exists circle l
 175   then Ast0.wrap(Ast0.CIRCLES(l))
 176   else
 177     if List.exists star l
 178     then Ast0.wrap(Ast0.STARS(l))
 179     else Ast0.wrap(Ast0.DOTS(l))
 180
 181 (* here the offset is that of the first in the sequence of *s, not that of
 182 each * individually *)
 183 let pointerify ty m =
 184   List.fold_left
 185     (function inner ->
 186       function cur ->
 187         Ast0.wrap(Ast0.Pointer(inner,clt2mcode "*" cur)))
 188     ty m
 189
 190 let ty_pointerify ty m =
 191   List.fold_left
 192     (function inner -> function cur -> Type_cocci.Pointer(inner))
 193     ty m
 194
 195 let arrayify ty ar =
 196   List.fold_right
 197     (function (l,i,r) ->
 198       function rest ->
 199         Ast0.wrap (Ast0.Array(rest,clt2mcode "[" l,i,clt2mcode "]" r)))
 200     ar ty
 201
 202 (* Left is <=>, Right is =>.  Collect <=>s. *)
 203 (* The parser should have done this, with precedences.  But whatever... *)
 204 let iso_adjust first_fn fn first rest =
 205   let rec loop = function
 206       [] -> [[]]
 207     | (Common.Left x)::rest ->
 208         (match loop rest with
 209           front::after -> (fn x::front)::after
 210         | _ -> failwith "not possible")
 211     | (Common.Right x)::rest ->
 212         (match loop rest with
 213           front::after -> []::(fn x::front)::after
 214         | _ -> failwith "not possible") in
 215   match loop rest with
 216     front::after -> (first_fn first::front)::after
 217   | _ -> failwith "not possible"
 218
 219 let lookup rule name =
 220   try
 221     let info = Hashtbl.find Data.all_metadecls rule in
 222     List.find (function mv -> Ast.get_meta_name mv = (rule,name)) info
 223   with
 224     Not_found ->
 225       raise
 226         (Semantic_cocci.Semantic("bad rule "^rule^" or bad variable "^name))
 227
 228 let check_meta_tyopt type_irrelevant = function
 229     Ast.MetaMetaDecl(Ast.NONE,(rule,name)) ->
 230       (match lookup rule name with
 231         Ast.MetaMetaDecl(_,_) -> ()
 232       | _ ->
 233           raise
 234             (Semantic_cocci.Semantic
 235                ("incompatible inheritance declaration "^name)))
 236   | Ast.MetaIdDecl(Ast.NONE,(rule,name)) ->
 237       (match lookup rule name with
 238         Ast.MetaIdDecl(_,_) | Ast.MetaFreshIdDecl(_,_) -> ()
 239       | _ ->
 240           raise
 241             (Semantic_cocci.Semantic
 242                ("incompatible inheritance declaration "^name)))
 243   | Ast.MetaFreshIdDecl((rule,name),seed) ->
 244       raise
 245         (Semantic_cocci.Semantic
 246            "can't inherit the freshness of an identifier")
 247   | Ast.MetaTypeDecl(Ast.NONE,(rule,name)) ->
 248       (match lookup rule name with
 249         Ast.MetaTypeDecl(_,_) -> ()
 250       | _ ->
 251           raise
 252             (Semantic_cocci.Semantic
 253                ("incompatible inheritance declaration "^name)))
 254   | Ast.MetaInitDecl(Ast.NONE,(rule,name)) ->
 255       (match lookup rule name with
 256         Ast.MetaInitDecl(_,_) -> ()
 257       | _ ->
 258           raise
 259             (Semantic_cocci.Semantic
 260                ("incompatible inheritance declaration "^name)))
 261   | Ast.MetaInitListDecl(Ast.NONE,(rule,name),len_name) ->
 262       (match lookup rule name with
 263         Ast.MetaInitListDecl(_,_,_) -> ()
 264       | _ ->
 265           raise
 266             (Semantic_cocci.Semantic
 267                ("incompatible inheritance declaration "^name)))
 268   | Ast.MetaListlenDecl((rule,name)) ->
 269       (match lookup rule name with
 270         Ast.MetaListlenDecl(_) -> ()
 271       | _ ->
 272           raise
 273             (Semantic_cocci.Semantic
 274                ("incompatible inheritance declaration "^name)))
 275   | Ast.MetaParamDecl(Ast.NONE,(rule,name)) ->
 276       (match lookup rule name with
 277         Ast.MetaParamDecl(_,_) -> ()
 278       | _ ->
 279           raise
 280             (Semantic_cocci.Semantic
 281                ("incompatible inheritance declaration "^name)))
 282   | Ast.MetaParamListDecl(Ast.NONE,(rule,name),len_name) ->
 283       (match lookup rule name with
 284         Ast.MetaParamListDecl(_,_,_) -> ()
 285       | _ ->
 286           raise
 287             (Semantic_cocci.Semantic
 288                ("incompatible inheritance declaration "^name)))
 289   | Ast.MetaConstDecl(Ast.NONE,(rule,name),ty) ->
 290       (match lookup rule name with
 291         Ast.MetaConstDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> ()
 292       | _ ->
 293           raise
 294             (Semantic_cocci.Semantic
 295                ("incompatible inheritance declaration "^name)))
 296   | Ast.MetaErrDecl(Ast.NONE,(rule,name)) ->
 297       (match lookup rule name with
 298         Ast.MetaErrDecl(_,_) -> ()
 299       | _ ->
 300           raise
 301             (Semantic_cocci.Semantic
 302                ("incompatible inheritance declaration "^name)))
 303   | Ast.MetaExpDecl(Ast.NONE,(rule,name),ty) ->
 304       (match lookup rule name with
 305         Ast.MetaExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> ()
 306       | _ ->
 307           raise
 308             (Semantic_cocci.Semantic
 309                ("incompatible inheritance declaration "^name)))
 310   | Ast.MetaIdExpDecl(Ast.NONE,(rule,name),ty) ->
 311       (match lookup rule name with
 312         Ast.MetaIdExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> ()
 313       | _ ->
 314           raise
 315             (Semantic_cocci.Semantic
 316                ("incompatible inheritance declaration "^name)))
 317   | Ast.MetaLocalIdExpDecl(Ast.NONE,(rule,name),ty) ->
 318       (match lookup rule name with
 319         Ast.MetaLocalIdExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> ()
 320       | _ ->
 321           raise
 322             (Semantic_cocci.Semantic
 323                ("incompatible inheritance declaration "^name)))
 324   | Ast.MetaExpListDecl(Ast.NONE,(rule,name),len_name) ->
 325       (match lookup rule name with
 326         Ast.MetaExpListDecl(_,_,_) -> ()
 327       | Ast.MetaParamListDecl(_,_,_) when not (!Flag.make_hrule = None) -> ()
 328       | _ ->
 329           raise
 330             (Semantic_cocci.Semantic
 331                ("incompatible inheritance declaration "^name)))
 332   | Ast.MetaDeclDecl(Ast.NONE,(rule,name)) ->
 333       (match lookup rule name with
 334         Ast.MetaDeclDecl(_,_) -> ()
 335       | _ ->
 336           raise
 337             (Semantic_cocci.Semantic
 338                ("incompatible inheritance declaration "^name)))
 339   | Ast.MetaFieldDecl(Ast.NONE,(rule,name)) ->
 340       (match lookup rule name with
 341         Ast.MetaFieldDecl(_,_) -> ()
 342       | _ ->
 343           raise
 344             (Semantic_cocci.Semantic
 345                ("incompatible inheritance declaration "^name)))
 346   | Ast.MetaFieldListDecl(Ast.NONE,(rule,name),len_name) ->
 347       (match lookup rule name with
 348         Ast.MetaFieldListDecl(_,_,_) -> ()
 349       | _ ->
 350           raise
 351             (Semantic_cocci.Semantic
 352                ("incompatible inheritance declaration "^name)))
 353   | Ast.MetaStmDecl(Ast.NONE,(rule,name)) ->
 354       (match lookup rule name with
 355         Ast.MetaStmDecl(_,_) -> ()
 356       | _ ->
 357           raise
 358             (Semantic_cocci.Semantic
 359                ("incompatible inheritance declaration "^name)))
 360   | Ast.MetaStmListDecl(Ast.NONE,(rule,name)) ->
 361       (match lookup rule name with
 362         Ast.MetaStmListDecl(_,_) -> ()
 363       | _ ->
 364           raise
 365             (Semantic_cocci.Semantic
 366                ("incompatible inheritance declaration "^name)))
 367   | Ast.MetaFuncDecl(Ast.NONE,(rule,name)) ->
 368       (match lookup rule name with
 369         Ast.MetaFuncDecl(_,_) -> ()
 370       | _ ->
 371           raise
 372             (Semantic_cocci.Semantic
 373                ("incompatible inheritance declaration "^name)))
 374   | Ast.MetaLocalFuncDecl(Ast.NONE,(rule,name)) ->
 375       (match lookup rule name with
 376         Ast.MetaLocalFuncDecl(_,_) -> ()
 377       | _ ->
 378           raise
 379             (Semantic_cocci.Semantic
 380                ("incompatible inheritance declaration "^name)))
 381   | Ast.MetaPosDecl(Ast.NONE,(rule,name)) ->
 382       (match lookup rule name with
 383         Ast.MetaPosDecl(_,_) ->
 384           if not (List.mem rule !Data.inheritable_positions) &&
 385             not !Data.ignore_patch_or_match
 386           then
 387             raise
 388               (Semantic_cocci.Semantic
 389                  ("position cannot be inherited over modifications: "^name))
 390       | _ ->
 391           raise
 392             (Semantic_cocci.Semantic
 393                ("incompatible inheritance declaration "^name)))
 394   | _ ->
 395       raise
 396         (Semantic_cocci.Semantic ("arity not allowed on imported declaration"))
 397
 398 let check_meta m = check_meta_tyopt false m
 399
 400 let check_inherited_constraint meta_name fn =
 401   match meta_name with
 402     (None,_) -> failwith "constraint must be an inherited variable"
 403   | (Some rule,name) ->
 404       let i = (rule,name) in
 405       check_meta_tyopt true (fn i);
 406       i
 407
 408 let create_metadec ar ispure kindfn ids current_rule =
 409   List.concat
 410     (List.map
 411        (function (rule,nm) ->
 412          let (rule,checker) =
 413            match rule with
 414              None -> ((current_rule,nm),function x -> [Common.Left x])
 415            | Some rule ->
 416                ((rule,nm),
 417                 function x -> check_meta x; [Common.Right x]) in
 418          kindfn ar rule ispure checker)
 419        ids)
 420
 421
 422 let create_metadec_virt ar ispure kindfn ids current_rule =
 423   List.concat
 424     (List.map
 425        (function nm ->
 426          let checker = function x -> [Common.Right x] in
 427          kindfn ar nm ispure checker !Flag.defined_virtual_env)
 428        ids)
 429
 430 let create_fresh_metadec kindfn ids current_rule =
 431   List.concat
 432     (List.map
 433        (function ((rule,nm),seed) ->
 434          let (rule,checker) =
 435            match rule with
 436              None -> ((current_rule,nm),function x -> [Common.Left x])
 437            | Some rule ->
 438                ((rule,nm),
 439                 function x -> check_meta x; [Common.Right x]) in
 440          kindfn rule checker seed)
 441        ids)
 442
 443 let create_metadec_with_constraints ar ispure kindfn ids current_rule =
 444   List.concat
 445     (List.map
 446        (function ((rule,nm),constraints) ->
 447          let (rule,checker) =
 448            match rule with
 449                None -> ((current_rule,nm),function x -> [Common.Left x])
 450              | Some rule ->
 451                  ((rule,nm),
 452                   function x -> check_meta x; [Common.Right x]) in
 453            kindfn ar rule ispure checker constraints)
 454        ids)
 455
 456 let create_metadec_ty ar ispure kindfn ids current_rule =
 457   List.concat
 458     (List.map
 459        (function ((rule,nm),constraints) ->
 460          let (rule,checker) =
 461            match rule with
 462              None -> ((current_rule,nm),function x -> [Common.Left x])
 463            | Some rule ->
 464                ((rule,nm),
 465                 function x -> check_meta x; [Common.Right x]) in
 466          kindfn ar rule ispure checker constraints)
 467        ids)
 468
 469 let create_len_metadec ar ispure kindfn lenid ids current_rule =
 470   let (lendec,lenname) =
 471     match lenid with
 472       Common.Left lenid ->
 473         let lendec =
 474           create_metadec Ast.NONE Ast0.Impure
 475             (fun _ name _ check_meta -> check_meta(Ast.MetaListlenDecl(name)))
 476             [lenid] current_rule in
 477         let lenname =
 478           match lendec with
 479             [Common.Left (Ast.MetaListlenDecl(x))] -> Ast.MetaLen x
 480           | [Common.Right (Ast.MetaListlenDecl(x))] -> Ast.MetaLen x
 481           | _ -> failwith "unexpected length declaration" in
 482         (lendec,lenname)
 483     | Common.Right n -> ([],Ast.CstLen n) in
 484   lendec@(create_metadec ar ispure (kindfn lenname) ids current_rule)
 485
 486 (* ---------------------------------------------------------------------- *)
 487
 488 let str2inc s =
 489   let elements = Str.split (Str.regexp "/") s in
 490   List.map (function "..." -> Ast.IncDots | s -> Ast.IncPath s) elements
 491
 492 (* ---------------------------------------------------------------------- *)
 493 (* declarations and statements *)
 494
 495 let meta_decl name =
 496   let (nm,pure,clt) = name in
 497   Ast0.wrap(Ast0.MetaDecl(clt2mcode nm clt,pure))
 498
 499 let meta_field name =
 500   let (nm,pure,clt) = name in
 501   Ast0.wrap(Ast0.MetaField(clt2mcode nm clt,pure))
 502
 503 let meta_field_list name =
 504   let (nm,lenname,pure,clt) = name in
 505   let lenname =
 506     match lenname with
 507       Ast.AnyLen -> Ast0.AnyListLen
 508     | Ast.MetaLen nm -> Ast0.MetaListLen(clt2mcode nm clt)
 509     | Ast.CstLen n -> Ast0.CstListLen n in
 510   Ast0.wrap(Ast0.MetaFieldList(clt2mcode nm clt,lenname,pure))
 511
 512 let meta_stm name =
 513   let (nm,pure,clt) = name in
 514   Ast0.wrap(Ast0.MetaStmt(clt2mcode nm clt,pure))
 515
 516 let exp_stm exp pv =
 517   Ast0.wrap(Ast0.ExprStatement (exp, clt2mcode ";" pv))
 518
 519 let make_fake_mcode _ = (Ast0.default_info(),Ast0.context_befaft(),-1)
 520
 521 let ifthen iff lp tst rp thn =
 522   Ast0.wrap(Ast0.IfThen(clt2mcode "if" iff,
 523     clt2mcode "(" lp,tst,clt2mcode ")" rp,thn,make_fake_mcode()))
 524
 525 let ifthenelse iff lp tst rp thn e els =
 526   Ast0.wrap(Ast0.IfThenElse(clt2mcode "if" iff,
 527     clt2mcode "(" lp,tst,clt2mcode ")" rp,thn,
 528     clt2mcode "else" e,els,make_fake_mcode()))
 529
 530 let forloop fr lp e1 sc1 e2 sc2 e3 rp s =
 531   Ast0.wrap(Ast0.For(clt2mcode "for" fr,clt2mcode "(" lp,
 532                      Ast0.wrap(Ast0.ForExp(e1,clt2mcode ";" sc1)),e2,
 533                      clt2mcode ";" sc2,e3,clt2mcode ")" rp,s,
 534                      make_fake_mcode()))
 535
 536 let forloop2 fr lp decl e2 sc2 e3 rp s =
 537   let bef = (Ast0.default_info(),Ast0.context_befaft()) in
 538   Ast0.wrap(Ast0.For(clt2mcode "for" fr,clt2mcode "(" lp,
 539                      Ast0.wrap(Ast0.ForDecl (bef,decl)),e2,
 540                      clt2mcode ";" sc2,e3,clt2mcode ")" rp,s,
 541                      make_fake_mcode()))
 542
 543 let whileloop w lp e rp s =
 544   Ast0.wrap(Ast0.While(clt2mcode "while" w,clt2mcode "(" lp,
 545                        e,clt2mcode ")" rp,s,make_fake_mcode()))
 546
 547 let doloop d s w lp e rp pv =
 548   Ast0.wrap(Ast0.Do(clt2mcode "do" d,s,clt2mcode "while" w,
 549                     clt2mcode "(" lp,e,clt2mcode ")" rp,
 550                     clt2mcode ";" pv))
 551
 552 let iterator i lp e rp s =
 553   Ast0.wrap(Ast0.Iterator(i,clt2mcode "(" lp,e,clt2mcode ")" rp,s,
 554                           make_fake_mcode()))
 555
 556 let switch s lp e rp lb d c rb =
 557   let d =
 558     List.map
 559       (function d ->
 560         Ast0.wrap(Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),d)))
 561       d in
 562   Ast0.wrap(Ast0.Switch(clt2mcode "switch" s,clt2mcode "(" lp,e,
 563                         clt2mcode ")" rp,clt2mcode "{" lb,
 564                         Ast0.wrap(Ast0.DOTS(d)),
 565                         Ast0.wrap(Ast0.DOTS(c)),clt2mcode "}" rb))
 566
 567 let ret_exp r e pv =
 568   Ast0.wrap(Ast0.ReturnExpr(clt2mcode "return" r,e,clt2mcode ";" pv))
 569
 570 let ret r pv =
 571   Ast0.wrap(Ast0.Return(clt2mcode "return" r,clt2mcode ";" pv))
 572
 573 let break b pv =
 574   Ast0.wrap(Ast0.Break(clt2mcode "break" b,clt2mcode ";" pv))
 575
 576 let cont c pv =
 577   Ast0.wrap(Ast0.Continue(clt2mcode "continue" c,clt2mcode ";" pv))
 578
 579 let label i dd =
 580   Ast0.wrap(Ast0.Label(i,clt2mcode ":" dd))
 581
 582 let goto g i pv =
 583   Ast0.wrap(Ast0.Goto(clt2mcode "goto" g,i,clt2mcode ";" pv))
 584
 585 let seq lb s rb =
 586   Ast0.wrap(Ast0.Seq(clt2mcode "{" lb,s,clt2mcode "}" rb))
 587
 588 (* ---------------------------------------------------------------------- *)
 589
 590 let check_rule_name = function
 591     Some nm ->
 592       let n = id2name nm in
 593       (try let _ =  Hashtbl.find Data.all_metadecls n in
 594       raise (Semantic_cocci.Semantic ("repeated rule name"))
 595       with Not_found -> Some n)
 596   | None -> None
 597
 598 let make_iso_rule_name_result n =
 599   (try let _ =  Hashtbl.find Data.all_metadecls n in
 600   raise (Semantic_cocci.Semantic ("repeated rule name"))
 601   with Not_found -> ());
 602   Ast.CocciRulename
 603     (Some n,Ast.NoDep,[],[],Ast.Undetermined,false (*discarded*))
 604
 605 let fix_dependencies d =
 606   let rec loop inverted = function
 607       Ast0.Dep s when inverted -> Ast.AntiDep s
 608     | Ast0.Dep s -> Ast.Dep s
 609     | Ast0.AntiDep d -> loop (not inverted) d
 610     | Ast0.EverDep s when inverted -> Ast.NeverDep s
 611     | Ast0.EverDep s -> Ast.EverDep s
 612     | Ast0.NeverDep s when inverted -> Ast.EverDep s
 613     | Ast0.NeverDep s -> Ast.NeverDep s
 614     | Ast0.AndDep(d1,d2) when inverted ->
 615         Ast.OrDep(loop inverted d1,loop inverted d2)
 616     | Ast0.AndDep(d1,d2) ->
 617         Ast.AndDep(loop inverted d1,loop inverted d2)
 618     | Ast0.OrDep(d1,d2) when inverted ->
 619         Ast.AndDep(loop inverted d1,loop inverted d2)
 620     | Ast0.OrDep(d1,d2) ->
 621         Ast.OrDep(loop inverted d1,loop inverted d2)
 622     | Ast0.NoDep -> Ast.NoDep
 623     | Ast0.FailDep -> Ast.FailDep in
 624   loop false d
 625
 626 let make_cocci_rule_name_result nm d i a e ee =
 627   Ast.CocciRulename (check_rule_name nm,fix_dependencies d,i,a,e,ee)
 628
 629 let make_generated_rule_name_result nm d i a e ee =
 630   Ast.GeneratedRulename (check_rule_name nm,fix_dependencies d,i,a,e,ee)
 631
 632 let make_script_rule_name_result lang nm deps =
 633   let l = id2name lang in
 634   Ast.ScriptRulename (check_rule_name nm,l,fix_dependencies deps)
 635
 636 let make_initial_script_rule_name_result lang deps =
 637   let l = id2name lang in
 638   Ast.InitialScriptRulename(None,l,fix_dependencies deps)
 639
 640 let make_final_script_rule_name_result lang deps =
 641   let l = id2name lang in
 642   Ast.FinalScriptRulename(None,l,fix_dependencies deps)
 643
 644 (* Allows type alone only when it is void and only when there is only one
 645     parameter.  This avoids ambiguity problems in the parser. *)
 646 let verify_parameter_declarations = function
 647     [] -> ()
 648   | [x] ->
 649       (match Ast0.unwrap x with
 650         Ast0.Param(t, None) ->
 651           (match Ast0.unwrap t with
 652             Ast0.BaseType(Ast.VoidType,_) -> ()
 653           | _ ->
 654               failwith
 655                 (Printf.sprintf
 656                    "%d: only void can be a parameter without an identifier"
 657                    (Ast0.get_line t)))
 658       | _ -> ())
 659   | l ->
 660       List.iter
 661         (function x ->
 662           match Ast0.unwrap x with
 663             Ast0.Param(t, None) ->
 664               failwith
 665                 (Printf.sprintf
 666                    "%d: only void alone can be a parameter without an identifier"
 667                    (Ast0.get_line t))
 668           | _ -> ())
 669         l
 670
 671 (* ---------------------------------------------------------------------- *)
 672 (* decide whether an init list is ordered or unordered *)
 673
 674 let struct_initializer initlist =
 675   let rec loop i =
 676     match Ast0.unwrap i with
 677       Ast0.InitGccExt _ -> true
 678     | Ast0.InitGccName _ -> true
 679     | Ast0.OptIni i | Ast0.UniqueIni i -> loop i
 680     | Ast0.MetaInit _ | Ast0.MetaInitList _ -> false (* ambiguous... *)
 681     | _ -> false in
 682   let l = Ast0.undots initlist in
 683   (l = []) or (List.exists loop l)
 684
 685 let drop_dot_commas initlist =
 686   match Ast0.unwrap initlist with
 687     Ast0.DOTS(l) ->
 688       let rec loop after_comma = function
 689           [] -> []
 690         | x::xs ->
 691             (match Ast0.unwrap x with
 692               Ast0.Idots(dots,whencode) -> x :: (loop true xs)
 693             | Ast0.IComma(comma) when after_comma -> (*drop*) loop false xs
 694             | _ -> x :: (loop false xs)) in
 695       Ast0.rewrap initlist (Ast0.DOTS(loop false l))
 696   | _ -> failwith "not supported"