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