parsing_cocci/parse_aux.ml

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