parsing_cocci/.#parse_aux.ml.1.23

   1 (*
   2 * Copyright 2005-2008, 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   { Ast0.line_start = line; Ast0.line_end = line;
  45     Ast0.logical_start = logical_line; Ast0.logical_end = logical_line;
  46     Ast0.attachable_start = true; Ast0.attachable_end = true;
  47     Ast0.mcode_start = []; Ast0.mcode_end = [];
  48     Ast0.column = col; Ast0.offset = offset;
  49     Ast0.strings_before = strbef; Ast0.strings_after = straft; }
  50
  51 let clt2info (_,line,logical_line,offset,col,strbef,straft,pos) =
  52   make_info line logical_line offset col strbef straft
  53
  54 let drop_bef (arity,line,lline,offset,col,strbef,straft,pos) =
  55   (arity,line,lline,offset,col,[],straft,pos)
  56
  57 let drop_aft (arity,line,lline,offset,col,strbef,straft,pos) =
  58   (arity,line,lline,offset,col,strbef,[],pos)
  59
  60 let clt2mcode str = function
  61     (Data.MINUS,line,lline,offset,col,strbef,straft,pos)       ->
  62       (str,Ast0.NONE,make_info line lline offset col strbef straft,
  63        Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos)
  64   | (Data.OPTMINUS,line,lline,offset,col,strbef,straft,pos)    ->
  65       (str,Ast0.OPT,make_info line lline offset col strbef straft,
  66        Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos)
  67   | (Data.UNIQUEMINUS,line,lline,offset,col,strbef,straft,pos) ->
  68       (str,Ast0.UNIQUE,make_info line lline offset col strbef straft,
  69        Ast0.MINUS(ref([],Ast0.default_token_info)),ref pos)
  70   | (Data.PLUS,line,lline,offset,col,strbef,straft,pos)        ->
  71       (str,Ast0.NONE,make_info line lline offset col strbef straft,Ast0.PLUS,
  72        ref pos)
  73   | (Data.CONTEXT,line,lline,offset,col,strbef,straft,pos)     ->
  74       (str,Ast0.NONE,make_info line lline offset col strbef straft,
  75        Ast0.CONTEXT(ref(Ast.NOTHING,
  76                         Ast0.default_token_info,Ast0.default_token_info)),
  77        ref pos)
  78   | (Data.OPT,line,lline,offset,col,strbef,straft,pos)         ->
  79       (str,Ast0.OPT,make_info line lline offset col strbef straft,
  80        Ast0.CONTEXT(ref(Ast.NOTHING,
  81                         Ast0.default_token_info,Ast0.default_token_info)),
  82        ref pos)
  83   | (Data.UNIQUE,line,lline,offset,col,strbef,straft,pos)      ->
  84       (str,Ast0.UNIQUE,make_info line lline offset col strbef straft,
  85        Ast0.CONTEXT(ref(Ast.NOTHING,
  86                         Ast0.default_token_info,Ast0.default_token_info)),
  87        ref pos)
  88
  89 let id2name   (name, clt) = name
  90 let id2clt    (name, clt) = clt
  91 let id2mcode  (name, clt) = clt2mcode name clt
  92
  93 let mkdots str (dot,whencode) =
  94   match str with
  95     "..." -> Ast0.wrap(Ast0.Dots(clt2mcode str dot, whencode))
  96   | "ooo" -> Ast0.wrap(Ast0.Circles(clt2mcode str dot, whencode))
  97   | "***" -> Ast0.wrap(Ast0.Stars(clt2mcode str dot, whencode))
  98   | _ -> failwith "cannot happen"
  99
 100 let mkedots str (dot,whencode) =
 101   match str with
 102     "..." -> Ast0.wrap(Ast0.Edots(clt2mcode str dot, whencode))
 103   | "ooo" -> Ast0.wrap(Ast0.Ecircles(clt2mcode str dot, whencode))
 104   | "***" -> Ast0.wrap(Ast0.Estars(clt2mcode str dot, whencode))
 105   | _ -> failwith "cannot happen"
 106
 107 let mkdpdots str dot =
 108   match str with
 109     "..." -> Ast0.wrap(Ast0.DPdots(clt2mcode str dot))
 110   | "ooo" -> Ast0.wrap(Ast0.DPcircles(clt2mcode str dot))
 111   | _ -> failwith "cannot happen"
 112
 113 let mkidots str (dot,whencode) =
 114   match str with
 115     "..." -> Ast0.wrap(Ast0.Idots(clt2mcode str dot, whencode))
 116   | _ -> failwith "cannot happen"
 117
 118 let mkddots str (dot,whencode) =
 119   match (str,whencode) with
 120     ("...",None) -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, None))
 121   | ("...",Some [w]) -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, Some w))
 122   | _ -> failwith "cannot happen"
 123
 124 let mkpdots str dot =
 125   match str with
 126     "..." -> Ast0.wrap(Ast0.Pdots(clt2mcode str dot))
 127   | "ooo" -> Ast0.wrap(Ast0.Pcircles(clt2mcode str dot))
 128   | _ -> failwith "cannot happen"
 129
 130 let arith_op ast_op left op right =
 131   Ast0.wrap
 132     (Ast0.Binary(left, clt2mcode (Ast.Arith ast_op) op, right))
 133
 134 let logic_op ast_op left op right =
 135   Ast0.wrap
 136     (Ast0.Binary(left, clt2mcode (Ast.Logical ast_op) op, right))
 137
 138 let make_cv cv ty =
 139   match cv with None -> ty | Some x -> Ast0.wrap (Ast0.ConstVol(x,ty))
 140
 141 let top_dots l =
 142   let circle x =
 143     match Ast0.unwrap x with Ast0.Circles(_) -> true | _ -> false in
 144   let star x =
 145     match Ast0.unwrap x with Ast0.Stars(_) -> true | _ -> false in
 146   if List.exists circle l
 147   then Ast0.wrap(Ast0.CIRCLES(l))
 148   else
 149     if List.exists star l
 150     then Ast0.wrap(Ast0.STARS(l))
 151     else Ast0.wrap(Ast0.DOTS(l))
 152
 153 (* here the offset is that of the first in the sequence of *s, not that of
 154 each * individually *)
 155 let pointerify ty m =
 156   List.fold_left
 157     (function inner ->
 158       function cur ->
 159         Ast0.wrap(Ast0.Pointer(inner,clt2mcode "*" cur)))
 160     ty m
 161
 162 let ty_pointerify ty m =
 163   List.fold_left
 164     (function inner -> function cur -> Type_cocci.Pointer(inner))
 165     ty m
 166
 167 (* Left is <=>, Right is =>.  Collect <=>s. *)
 168 (* The parser should have done this, with precedences.  But whatever... *)
 169 let iso_adjust fn first rest =
 170   let rec loop = function
 171       [] -> [[]]
 172     | (Common.Left x)::rest ->
 173         (match loop rest with
 174           front::after -> (fn x::front)::after
 175         | _ -> failwith "not possible")
 176     | (Common.Right x)::rest ->
 177         (match loop rest with
 178           front::after -> []::(fn x::front)::after
 179         | _ -> failwith "not possible") in
 180   match loop rest with
 181     front::after -> (fn first::front)::after
 182   | _ -> failwith "not possible"
 183
 184 let check_meta tok =
 185   let lookup rule name =
 186     try
 187       let info = Hashtbl.find Data.all_metadecls rule in
 188       List.find (function mv -> Ast.get_meta_name mv = (rule,name)) info
 189     with
 190       Not_found ->
 191         raise
 192           (Semantic_cocci.Semantic
 193              ("bad rule "^rule^" or bad variable "^name)) in
 194   match tok with
 195     Ast.MetaIdDecl(Ast.NONE,(rule,name)) ->
 196       (match lookup rule name with
 197         Ast.MetaIdDecl(_,_) | Ast.MetaFreshIdDecl(_,_) -> ()
 198       | _ ->
 199           raise
 200             (Semantic_cocci.Semantic
 201                ("incompatible inheritance declaration "^name)))
 202   | Ast.MetaFreshIdDecl(Ast.NONE,(rule,name)) ->
 203       raise
 204         (Semantic_cocci.Semantic
 205            "can't inherit the freshness of an identifier")
 206   | Ast.MetaListlenDecl((rule,name)) ->
 207       (match lookup rule name with
 208         Ast.MetaListlenDecl(_) -> ()
 209       | _ ->
 210           raise
 211             (Semantic_cocci.Semantic
 212                ("incompatible inheritance declaration "^name)))
 213   | Ast.MetaTypeDecl(Ast.NONE,(rule,name)) ->
 214       (match lookup rule name with
 215         Ast.MetaTypeDecl(_,_) -> ()
 216       | _ ->
 217           raise
 218             (Semantic_cocci.Semantic
 219                ("incompatible inheritance declaration "^name)))
 220   | Ast.MetaParamDecl(Ast.NONE,(rule,name)) ->
 221       (match lookup rule name with
 222         Ast.MetaParamDecl(_,_) -> ()
 223       | _ ->
 224           raise
 225             (Semantic_cocci.Semantic
 226                ("incompatible inheritance declaration "^name)))
 227   | Ast.MetaParamListDecl(Ast.NONE,(rule,name),len_name) ->
 228       (match lookup rule name with
 229         Ast.MetaParamListDecl(_,_,_) -> ()
 230       | _ ->
 231           raise
 232             (Semantic_cocci.Semantic
 233                ("incompatible inheritance declaration "^name)))
 234   | Ast.MetaErrDecl(Ast.NONE,(rule,name)) ->
 235       (match lookup rule name with
 236         Ast.MetaErrDecl(_,_) -> ()
 237       | _ ->
 238           raise
 239             (Semantic_cocci.Semantic
 240                ("incompatible inheritance declaration "^name)))
 241   | Ast.MetaExpDecl(Ast.NONE,(rule,name),ty) ->
 242       (match lookup rule name with
 243         Ast.MetaExpDecl(_,_,ty1) when ty = ty1 -> ()
 244       | _ ->
 245           raise
 246             (Semantic_cocci.Semantic
 247                ("incompatible inheritance declaration "^name)))
 248   | Ast.MetaIdExpDecl(Ast.NONE,(rule,name),ty) ->
 249       (match lookup rule name with
 250         Ast.MetaIdExpDecl(_,_,ty1) when ty = ty1 -> ()
 251       | _ ->
 252           raise
 253             (Semantic_cocci.Semantic
 254                ("incompatible inheritance declaration "^name)))
 255   | Ast.MetaLocalIdExpDecl(Ast.NONE,(rule,name),ty) ->
 256       (match lookup rule name with
 257         Ast.MetaLocalIdExpDecl(_,_,ty1) when ty = ty1 -> ()
 258       | _ ->
 259           raise
 260             (Semantic_cocci.Semantic
 261                ("incompatible inheritance declaration "^name)))
 262   | Ast.MetaExpListDecl(Ast.NONE,(rule,name),len_name) ->
 263       (match lookup rule name with
 264         Ast.MetaExpListDecl(_,_,_) -> ()
 265       | _ ->
 266           raise
 267             (Semantic_cocci.Semantic
 268                ("incompatible inheritance declaration "^name)))
 269   | Ast.MetaStmDecl(Ast.NONE,(rule,name)) ->
 270       (match lookup rule name with
 271         Ast.MetaStmDecl(_,_) -> ()
 272       | _ ->
 273           raise
 274             (Semantic_cocci.Semantic
 275                ("incompatible inheritance declaration "^name)))
 276   | Ast.MetaStmListDecl(Ast.NONE,(rule,name)) ->
 277       (match lookup rule name with
 278         Ast.MetaStmListDecl(_,_) -> ()
 279       | _ ->
 280           raise
 281             (Semantic_cocci.Semantic
 282                ("incompatible inheritance declaration "^name)))
 283   | Ast.MetaFuncDecl(Ast.NONE,(rule,name)) ->
 284       (match lookup rule name with
 285         Ast.MetaFuncDecl(_,_) -> ()
 286       | _ ->
 287           raise
 288             (Semantic_cocci.Semantic
 289                ("incompatible inheritance declaration "^name)))
 290   | Ast.MetaLocalFuncDecl(Ast.NONE,(rule,name)) ->
 291       (match lookup rule name with
 292         Ast.MetaLocalFuncDecl(_,_) -> ()
 293       | _ ->
 294           raise
 295             (Semantic_cocci.Semantic
 296                ("incompatible inheritance declaration "^name)))
 297   | Ast.MetaConstDecl(Ast.NONE,(rule,name),ty) ->
 298       (match lookup rule name with
 299         Ast.MetaConstDecl(_,_,ty1) when ty = ty1 -> ()
 300       | _ ->
 301           raise
 302             (Semantic_cocci.Semantic
 303                ("incompatible inheritance declaration "^name)))
 304   | Ast.MetaPosDecl(Ast.NONE,(rule,name)) ->
 305       (match lookup rule name with
 306         Ast.MetaPosDecl(_,_) ->
 307           if not (List.mem rule !Data.inheritable_positions)
 308           then
 309             raise
 310               (Semantic_cocci.Semantic
 311                  ("position cannot be inherited over modifications: "^name))
 312       | _ ->
 313           raise
 314             (Semantic_cocci.Semantic
 315                ("incompatible inheritance declaration "^name)))
 316   | _ ->
 317       raise
 318         (Semantic_cocci.Semantic ("arity not allowed on imported declaration"))
 319
 320 let create_metadec ar ispure kindfn ids current_rule =
 321   List.concat
 322     (List.map
 323        (function (rule,nm) ->
 324          let (rule,checker) =
 325            match rule with
 326              None -> ((current_rule,nm),function x -> [Common.Left x])
 327            | Some rule ->
 328                ((rule,nm),
 329                 function x -> check_meta x; [Common.Right x]) in
 330          kindfn ar rule ispure checker)
 331        ids)
 332
 333 let create_metadec_ne ar ispure kindfn ids current_rule =
 334   List.concat
 335     (List.map
 336        (function ((rule,nm),constraints) ->
 337          let (rule,checker) =
 338            match rule with
 339              None -> ((current_rule,nm),function x -> [Common.Left x])
 340            | Some rule ->
 341                ((rule,nm),
 342                 function x -> check_meta x; [Common.Right x]) in
 343          kindfn ar rule ispure checker constraints)
 344        ids)
 345
 346 let create_metadec_ty ar ispure kindfn ids current_rule =
 347   List.concat
 348     (List.map
 349        (function ((rule,nm),constraints) ->
 350          let (rule,checker) =
 351            match rule with
 352              None -> ((current_rule,nm),function x -> [Common.Left x])
 353            | Some rule ->
 354                ((rule,nm),
 355                 function x -> check_meta x; [Common.Right x]) in
 356          kindfn ar rule ispure checker constraints)
 357        ids)
 358
 359 let create_len_metadec ar ispure kindfn lenid ids current_rule =
 360   let lendec =
 361     create_metadec Ast.NONE Ast0.Impure
 362       (fun _ name _ check_meta -> check_meta(Ast.MetaListlenDecl(name)))
 363       [lenid] current_rule in
 364   let lenname =
 365     match lendec with
 366       [Common.Left (Ast.MetaListlenDecl(x))] -> x
 367     | [Common.Right (Ast.MetaListlenDecl(x))] -> x
 368     | _ -> failwith "unexpected length declaration" in
 369   lendec@(create_metadec ar ispure (kindfn lenname) ids current_rule)
 370
 371 (* ---------------------------------------------------------------------- *)
 372
 373 let str2inc s =
 374   let elements = Str.split (Str.regexp "/") s in
 375   List.map (function "..." -> Ast.IncDots | s -> Ast.IncPath s) elements
 376
 377 (* ---------------------------------------------------------------------- *)
 378 (* statements *)
 379
 380 let meta_stm name =
 381   let (nm,pure,clt) = name in
 382   Ast0.wrap(Ast0.MetaStmt(clt2mcode nm clt,pure))
 383
 384 let exp_stm exp pv =
 385   Ast0.wrap(Ast0.ExprStatement (exp, clt2mcode ";" pv))
 386
 387 let ifthen iff lp tst rp thn =
 388   Ast0.wrap(Ast0.IfThen(clt2mcode "if" iff,
 389     clt2mcode "(" lp,tst,clt2mcode ")" rp,thn,
 390     (Ast0.default_info(),Ast0.context_befaft())))
 391
 392 let ifthenelse iff lp tst rp thn e els =
 393   Ast0.wrap(Ast0.IfThenElse(clt2mcode "if" iff,
 394     clt2mcode "(" lp,tst,clt2mcode ")" rp,thn,
 395     clt2mcode "else" e,els,
 396     (Ast0.default_info(),Ast0.context_befaft())))
 397
 398 let forloop fr lp e1 sc1 e2 sc2 e3 rp s =
 399   Ast0.wrap(Ast0.For(clt2mcode "for" fr,clt2mcode "(" lp,e1,
 400                      clt2mcode ";" sc1,e2,
 401                      clt2mcode ";" sc2,e3,clt2mcode ")" rp,s,
 402                      (Ast0.default_info(),Ast0.context_befaft())))
 403
 404 let whileloop w lp e rp s =
 405   Ast0.wrap(Ast0.While(clt2mcode "while" w,clt2mcode "(" lp,
 406                        e,clt2mcode ")" rp,s,
 407                        (Ast0.default_info(),Ast0.context_befaft())))
 408
 409 let doloop d s w lp e rp pv =
 410   Ast0.wrap(Ast0.Do(clt2mcode "do" d,s,clt2mcode "while" w,
 411                     clt2mcode "(" lp,e,clt2mcode ")" rp,
 412                     clt2mcode ";" pv))
 413
 414 let iterator i lp e rp s =
 415   Ast0.wrap(Ast0.Iterator(i,clt2mcode "(" lp,e,clt2mcode ")" rp,s,
 416                           (Ast0.default_info(),Ast0.context_befaft())))
 417
 418 let switch s lp e rp lb c rb =
 419   Ast0.wrap(Ast0.Switch(clt2mcode "switch" s,clt2mcode "(" lp,e,
 420                         clt2mcode ")" rp,clt2mcode "{" lb,
 421                         Ast0.wrap(Ast0.DOTS(c)),clt2mcode "}" rb))
 422
 423 let ret_exp r e pv =
 424   Ast0.wrap(Ast0.ReturnExpr(clt2mcode "return" r,e,clt2mcode ";" pv))
 425
 426 let ret r pv =
 427   Ast0.wrap(Ast0.Return(clt2mcode "return" r,clt2mcode ";" pv))
 428
 429 let break b pv =
 430   Ast0.wrap(Ast0.Break(clt2mcode "break" b,clt2mcode ";" pv))
 431
 432 let cont c pv =
 433   Ast0.wrap(Ast0.Continue(clt2mcode "continue" c,clt2mcode ";" pv))
 434
 435 let label i dd =
 436   Ast0.wrap(Ast0.Label(i,clt2mcode ":" dd))
 437
 438 let goto g i pv =
 439   Ast0.wrap(Ast0.Goto(clt2mcode "goto" g,i,clt2mcode ";" pv))
 440
 441 let seq lb s rb =
 442   Ast0.wrap(Ast0.Seq(clt2mcode "{" lb,s,clt2mcode "}" rb))
 443
 444 (* ---------------------------------------------------------------------- *)
 445
 446 let make_iso_rule_name_result n =
 447     (try let _ =  Hashtbl.find Data.all_metadecls n in
 448     raise (Semantic_cocci.Semantic ("repeated rule name"))
 449     with Not_found -> ());
 450     Ast.CocciRulename (Some n,Ast.NoDep,[],[],Ast.Undetermined,false (*discarded*))
 451
 452 let make_cocci_rule_name_result nm d i a e ee =
 453   match nm with
 454     Some nm ->
 455       let n = id2name nm in
 456       (try let _ =  Hashtbl.find Data.all_metadecls n in
 457       raise (Semantic_cocci.Semantic ("repeated rule name"))
 458       with Not_found -> ());
 459       Ast.CocciRulename (Some n,d,i,a,e,ee)
 460   | None -> Ast.CocciRulename (None,d,i,a,e,ee)
 461
 462 let make_script_rule_name_result scr lang deps =
 463   let s = id2name scr in
 464   let l = id2name lang in
 465   if s <> "script" then
 466     raise (Semantic_cocci.Semantic ("malformed script rule"));
 467   Ast.ScriptRulename (l,deps)