parsing_cocci/parse_aux.ml

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