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