parsing_cocci/disjdistr.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, Nicolas Palix
   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 module Ast = Ast_cocci
  24 module V = Visitor_ast
  25
  26 let setify l = (* keep first *)
  27   let rec loop seen = function
  28       [] -> []
  29     | x::xs ->
  30         if List.mem x seen then loop seen xs else x::(loop (x::seen) xs) in
  31   loop [] l
  32
  33 let disjmult2 e1 e2 k =
  34   List.concat
  35     (List.map (function e1 -> List.map (function e2 -> k e1 e2) e2) e1)
  36
  37 let disjmult3 e1 e2 e3 k =
  38   List.concat
  39     (List.map
  40        (function e1 ->
  41          List.concat
  42            (List.map
  43               (function e2 -> List.map (function e3 -> k e1 e2 e3) e3)
  44               e2))
  45        e1)
  46
  47 let rec disjmult f = function
  48     [] -> [[]]
  49   | x::xs ->
  50       let cur = f x in
  51       let rest = disjmult f xs in
  52       disjmult2 cur rest (function cur -> function rest -> cur :: rest)
  53
  54 let disjoption f = function
  55     None -> [None]
  56   | Some x -> List.map (function x -> Some x) (f x)
  57
  58 let disjdots f d =
  59   match Ast.unwrap d with
  60     Ast.DOTS(l) ->
  61       List.map (function l -> Ast.rewrap d (Ast.DOTS(l))) (disjmult f l)
  62   | Ast.CIRCLES(l) ->
  63       List.map (function l -> Ast.rewrap d (Ast.CIRCLES(l))) (disjmult f l)
  64   | Ast.STARS(l) ->
  65       List.map (function l -> Ast.rewrap d (Ast.STARS(l))) (disjmult f l)
  66
  67 let rec disjty ft =
  68   match Ast.unwrap ft with
  69     Ast.Type(cv,ty) ->
  70       let ty = disjtypeC ty in
  71       List.map (function ty -> Ast.rewrap ft (Ast.Type(cv,ty))) ty
  72   | Ast.DisjType(types) -> List.concat (List.map disjty types)
  73   | Ast.OptType(ty) ->
  74       let ty = disjty ty in
  75       List.map (function ty -> Ast.rewrap ft (Ast.OptType(ty))) ty
  76   | Ast.UniqueType(ty) ->
  77       let ty = disjty ty in
  78       List.map (function ty -> Ast.rewrap ft (Ast.UniqueType(ty))) ty
  79
  80 and disjtypeC bty =
  81   match Ast.unwrap bty with
  82     Ast.BaseType(_) | Ast.SignedT(_,_) -> [bty]
  83   | Ast.Pointer(ty,star) ->
  84       let ty = disjty ty in
  85       List.map (function ty -> Ast.rewrap bty (Ast.Pointer(ty,star))) ty
  86   | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
  87       let ty = disjty ty in
  88       List.map
  89         (function ty ->
  90           Ast.rewrap bty (Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)))
  91         ty
  92   | Ast.FunctionType (s,ty,lp1,params,rp1) ->
  93       let ty = disjoption disjty ty in
  94       List.map
  95         (function ty ->
  96           Ast.rewrap bty (Ast.FunctionType (s,ty,lp1,params,rp1)))
  97         ty
  98   | Ast.Array(ty,lb,size,rb) ->
  99       disjmult2 (disjty ty) (disjoption disjexp size)
 100         (function ty -> function size ->
 101           Ast.rewrap bty (Ast.Array(ty,lb,size,rb)))
 102   | Ast.EnumName(_,_) | Ast.StructUnionName(_,_) -> [bty]
 103   | Ast.StructUnionDef(ty,lb,decls,rb) ->
 104       disjmult2 (disjty ty) (disjdots disjdecl decls)
 105         (function ty -> function decls ->
 106           Ast.rewrap bty (Ast.StructUnionDef(ty,lb,decls,rb)))
 107   | Ast.TypeName(_) | Ast.MetaType(_,_,_) -> [bty]
 108
 109 and disjexp e =
 110   match Ast.unwrap e with
 111     Ast.Ident(_) | Ast.Constant(_) -> [e]
 112   | Ast.FunCall(fn,lp,args,rp) ->
 113       disjmult2 (disjexp fn) (disjdots disjexp args)
 114         (function fn -> function args ->
 115           Ast.rewrap e (Ast.FunCall(fn,lp,args,rp)))
 116   | Ast.Assignment(left,op,right,simple) ->
 117       disjmult2 (disjexp left) (disjexp right)
 118         (function left -> function right ->
 119           Ast.rewrap e (Ast.Assignment(left,op,right,simple)))
 120   | Ast.CondExpr(exp1,why,Some exp2,colon,exp3) ->
 121       let res = disjmult disjexp [exp1;exp2;exp3] in
 122       List.map
 123         (function
 124             [exp1;exp2;exp3] ->
 125               Ast.rewrap e (Ast.CondExpr(exp1,why,Some exp2,colon,exp3))
 126           | _ -> failwith "not possible")
 127         res
 128   | Ast.CondExpr(exp1,why,None,colon,exp3) ->
 129       disjmult2 (disjexp exp1) (disjexp exp3)
 130         (function exp1 -> function exp3 ->
 131           Ast.rewrap e (Ast.CondExpr(exp1,why,None,colon,exp3)))
 132   | Ast.Postfix(exp,op) ->
 133       let exp = disjexp exp in
 134       List.map (function exp -> Ast.rewrap e (Ast.Postfix(exp,op))) exp
 135   | Ast.Infix(exp,op) ->
 136       let exp = disjexp exp in
 137       List.map (function exp -> Ast.rewrap e (Ast.Infix(exp,op))) exp
 138   | Ast.Unary(exp,op) ->
 139       let exp = disjexp exp in
 140       List.map (function exp -> Ast.rewrap e (Ast.Unary(exp,op))) exp
 141   | Ast.Binary(left,op,right) ->
 142       disjmult2 (disjexp left) (disjexp right)
 143         (function left -> function right ->
 144           Ast.rewrap e (Ast.Binary(left,op,right)))
 145   | Ast.Nested(exp,op,right) ->
 146       (* disj not possible in right *)
 147       let exp = disjexp exp in
 148       List.map (function exp -> Ast.rewrap e (Ast.Nested(exp,op,right))) exp
 149   | Ast.Paren(lp,exp,rp) ->
 150       let exp = disjexp exp in
 151       List.map (function exp -> Ast.rewrap e (Ast.Paren(lp,exp,rp))) exp
 152   | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
 153       disjmult2 (disjexp exp1) (disjexp exp2)
 154         (function exp1 -> function exp2 ->
 155           Ast.rewrap e (Ast.ArrayAccess(exp1,lb,exp2,rb)))
 156   | Ast.RecordAccess(exp,pt,field) ->
 157       let exp = disjexp exp in
 158       List.map
 159         (function exp -> Ast.rewrap e (Ast.RecordAccess(exp,pt,field))) exp
 160   | Ast.RecordPtAccess(exp,ar,field) ->
 161       let exp = disjexp exp in
 162       List.map
 163         (function exp -> Ast.rewrap e (Ast.RecordPtAccess(exp,ar,field))) exp
 164   | Ast.Cast(lp,ty,rp,exp) ->
 165       disjmult2 (disjty ty) (disjexp exp)
 166         (function ty -> function exp -> Ast.rewrap e (Ast.Cast(lp,ty,rp,exp)))
 167   | Ast.SizeOfExpr(szf,exp) ->
 168       let exp = disjexp exp in
 169       List.map (function exp -> Ast.rewrap e (Ast.SizeOfExpr(szf,exp))) exp
 170   | Ast.SizeOfType(szf,lp,ty,rp) ->
 171       let ty = disjty ty in
 172       List.map
 173         (function ty -> Ast.rewrap e (Ast.SizeOfType(szf,lp,ty,rp))) ty
 174   | Ast.TypeExp(ty) ->
 175       let ty = disjty ty in
 176       List.map (function ty -> Ast.rewrap e (Ast.TypeExp(ty))) ty
 177   | Ast.MetaErr(_,_,_,_) | Ast.MetaExpr(_,_,_,_,_,_)
 178   | Ast.MetaExprList(_,_,_,_) | Ast.EComma(_) -> [e]
 179   | Ast.DisjExpr(exp_list) ->
 180       List.concat (List.map disjexp exp_list)
 181   | Ast.NestExpr(expr_dots,whencode,multi) ->
 182       (* not sure what to do here, so ambiguities still possible *)
 183       [e]
 184   | Ast.Edots(dots,_) | Ast.Ecircles(dots,_) | Ast.Estars(dots,_) -> [e]
 185   | Ast.OptExp(exp) ->
 186       let exp = disjexp exp in
 187       List.map (function exp -> Ast.rewrap e (Ast.OptExp(exp))) exp
 188   | Ast.UniqueExp(exp) ->
 189       let exp = disjexp exp in
 190       List.map (function exp -> Ast.rewrap e (Ast.UniqueExp(exp))) exp
 191
 192 and disjparam p =
 193   match Ast.unwrap p with
 194     Ast.VoidParam(ty) -> [p] (* void is the only possible value *)
 195   | Ast.Param(ty,id) ->
 196       let ty = disjty ty in
 197       List.map (function ty -> Ast.rewrap p (Ast.Param(ty,id))) ty
 198   | Ast.MetaParam(_,_,_) | Ast.MetaParamList(_,_,_,_) | Ast.PComma(_) -> [p]
 199   | Ast.Pdots(dots) | Ast.Pcircles(dots) -> [p]
 200   | Ast.OptParam(param) ->
 201       let param = disjparam param in
 202       List.map (function param -> Ast.rewrap p (Ast.OptParam(param))) param
 203   | Ast.UniqueParam(param) ->
 204       let param = disjparam param in
 205       List.map (function param -> Ast.rewrap p (Ast.UniqueParam(param))) param
 206
 207 and disjini i =
 208   match Ast.unwrap i with
 209     Ast.MetaInit(_,_,_) -> [i]
 210   | Ast.InitExpr(exp) ->
 211       let exp = disjexp exp in
 212       List.map (function exp -> Ast.rewrap i (Ast.InitExpr(exp))) exp
 213   | Ast.InitList(lb,initlist,rb,whencode) ->
 214       List.map
 215         (function initlist ->
 216           Ast.rewrap i (Ast.InitList(lb,initlist,rb,whencode)))
 217         (disjmult disjini initlist)
 218   | Ast.InitGccExt(designators,eq,ini) ->
 219       let designators = disjmult designator designators in
 220       let ini = disjini ini in
 221       disjmult2 designators ini
 222         (function designators -> function ini ->
 223           Ast.rewrap i (Ast.InitGccExt(designators,eq,ini)))
 224   | Ast.InitGccName(name,eq,ini) ->
 225       let ini = disjini ini in
 226       List.map
 227         (function ini -> Ast.rewrap i (Ast.InitGccName(name,eq,ini)))
 228         ini
 229   | Ast.IComma(comma) -> [i]
 230   | Ast.OptIni(ini) ->
 231       let ini = disjini ini in
 232       List.map (function ini -> Ast.rewrap i (Ast.OptIni(ini))) ini
 233   | Ast.UniqueIni(ini) ->
 234       let ini = disjini ini in
 235       List.map (function ini -> Ast.rewrap i (Ast.UniqueIni(ini))) ini
 236
 237 and designator = function
 238     Ast.DesignatorField(dot,id) -> [Ast.DesignatorField(dot,id)]
 239   | Ast.DesignatorIndex(lb,exp,rb) ->
 240       let exp = disjexp exp in
 241       List.map (function exp -> Ast.DesignatorIndex(lb,exp,rb)) exp
 242   | Ast.DesignatorRange(lb,min,dots,max,rb) ->
 243       disjmult2 (disjexp min) (disjexp max)
 244         (function min -> function max ->
 245           Ast.DesignatorRange(lb,min,dots,max,rb))
 246
 247 and disjdecl d =
 248   match Ast.unwrap d with
 249     Ast.Init(stg,ty,id,eq,ini,sem) ->
 250       disjmult2 (disjty ty) (disjini ini)
 251         (function ty -> function ini ->
 252           Ast.rewrap d (Ast.Init(stg,ty,id,eq,ini,sem)))
 253   | Ast.UnInit(stg,ty,id,sem) ->
 254       let ty = disjty ty in
 255       List.map (function ty -> Ast.rewrap d (Ast.UnInit(stg,ty,id,sem))) ty
 256   | Ast.MacroDecl(name,lp,args,rp,sem) ->
 257       List.map
 258         (function args -> Ast.rewrap d (Ast.MacroDecl(name,lp,args,rp,sem)))
 259         (disjdots disjexp args)
 260   | Ast.TyDecl(ty,sem) ->
 261       let ty = disjty ty in
 262       List.map (function ty -> Ast.rewrap d (Ast.TyDecl(ty,sem))) ty
 263   | Ast.Typedef(stg,ty,id,sem) ->
 264       let ty = disjty ty in (* disj not allowed in id *)
 265       List.map (function ty -> Ast.rewrap d (Ast.Typedef(stg,ty,id,sem))) ty
 266   | Ast.DisjDecl(decls) -> List.concat (List.map disjdecl decls)
 267   | Ast.Ddots(_,_) | Ast.MetaDecl(_,_,_) -> [d]
 268   | Ast.OptDecl(decl) ->
 269       let decl = disjdecl decl in
 270       List.map (function decl -> Ast.rewrap d (Ast.OptDecl(decl))) decl
 271   | Ast.UniqueDecl(decl) ->
 272       let decl = disjdecl decl in
 273       List.map (function decl -> Ast.rewrap d (Ast.UniqueDecl(decl))) decl
 274
 275 let generic_orify_rule_elem f re exp rebuild =
 276   match f exp with
 277     [exp] -> re
 278   | orexps ->
 279       Ast.rewrap re (Ast.DisjRuleElem (setify(List.map rebuild orexps)))
 280
 281 let orify_rule_elem re exp rebuild =
 282   generic_orify_rule_elem disjexp re exp rebuild
 283
 284 let orify_rule_elem_ty = generic_orify_rule_elem disjty
 285 let orify_rule_elem_param = generic_orify_rule_elem disjparam
 286 let orify_rule_elem_decl = generic_orify_rule_elem disjdecl
 287 let orify_rule_elem_ini = generic_orify_rule_elem disjini
 288
 289 let rec disj_rule_elem r k re =
 290   match Ast.unwrap re with
 291     Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
 292       generic_orify_rule_elem (disjdots disjparam) re params
 293         (function params ->
 294           Ast.rewrap re
 295             (Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp)))
 296   | Ast.Decl(bef,allminus,decl) ->
 297       orify_rule_elem_decl re decl
 298         (function decl -> Ast.rewrap re (Ast.Decl(bef,allminus,decl)))
 299   | Ast.SeqStart(brace) -> re
 300   | Ast.SeqEnd(brace) -> re
 301   | Ast.ExprStatement(exp,sem) ->
 302       orify_rule_elem re exp
 303         (function exp -> Ast.rewrap re (Ast.ExprStatement(exp,sem)))
 304   | Ast.IfHeader(iff,lp,exp,rp) ->
 305       orify_rule_elem re exp
 306         (function exp -> Ast.rewrap re (Ast.IfHeader(iff,lp,exp,rp)))
 307   | Ast.Else(els) -> re
 308   | Ast.WhileHeader(whl,lp,exp,rp) ->
 309       orify_rule_elem re exp
 310         (function exp -> Ast.rewrap re (Ast.WhileHeader(whl,lp,exp,rp)))
 311   | Ast.DoHeader(d) -> re
 312   | Ast.WhileTail(whl,lp,exp,rp,sem) ->
 313       orify_rule_elem re exp
 314         (function exp -> Ast.rewrap re (Ast.WhileTail(whl,lp,exp,rp,sem)))
 315   | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
 316       generic_orify_rule_elem (disjmult (disjoption disjexp)) re [e1;e2;e3]
 317         (function
 318             [exp1;exp2;exp3] ->
 319               Ast.rewrap re (Ast.ForHeader(fr,lp,exp1,sem1,exp2,sem2,exp3,rp))
 320           | _ -> failwith "not possible")
 321   | Ast.IteratorHeader(whl,lp,args,rp) ->
 322       generic_orify_rule_elem (disjdots disjexp) re args
 323         (function args -> Ast.rewrap re (Ast.IteratorHeader(whl,lp,args,rp)))
 324   | Ast.SwitchHeader(switch,lp,exp,rp) ->
 325       orify_rule_elem re exp
 326         (function exp -> Ast.rewrap re (Ast.SwitchHeader(switch,lp,exp,rp)))
 327   | Ast.Break(_,_) | Ast.Continue(_,_) | Ast.Label(_,_) | Ast.Goto(_,_,_)
 328   | Ast.Return(_,_) -> re
 329   | Ast.ReturnExpr(ret,exp,sem) ->
 330       orify_rule_elem re exp
 331         (function exp -> Ast.rewrap re (Ast.ReturnExpr(ret,exp,sem)))
 332   | Ast.MetaRuleElem(_,_,_) | Ast.MetaStmt(_,_,_,_)
 333   | Ast.MetaStmtList(_,_,_) -> re
 334   | Ast.Exp(exp) ->
 335       orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.Exp(exp)))
 336   | Ast.TopExp(exp) ->
 337       orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.TopExp(exp)))
 338   | Ast.Ty(ty) ->
 339       orify_rule_elem_ty re ty (function ty -> Ast.rewrap ty (Ast.Ty(ty)))
 340   | Ast.TopInit(init) ->
 341       orify_rule_elem_ini re init
 342         (function init -> Ast.rewrap init (Ast.TopInit(init)))
 343   | Ast.Include(inc,s) -> re
 344   | Ast.DefineHeader(def,id,params) -> re
 345   | Ast.Default(def,colon) -> re
 346   | Ast.Case(case,exp,colon) ->
 347       orify_rule_elem re exp
 348         (function exp -> Ast.rewrap re (Ast.Case(case,exp,colon)))
 349   | Ast.DisjRuleElem(l) ->
 350       (* only case lines *)
 351       Ast.rewrap re(Ast.DisjRuleElem(setify(List.map (disj_rule_elem r k) l)))
 352
 353 let disj_all =
 354   let mcode x = x in
 355   let donothing r k e = k e in
 356   V.rebuilder
 357     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 358     donothing donothing donothing donothing
 359     donothing donothing donothing donothing donothing donothing donothing
 360     disj_rule_elem donothing donothing donothing donothing
 361
 362 (* ----------------------------------------------------------------------- *)
 363 (* collect iso information at the rule_elem level *)
 364
 365 let collect_all_isos =
 366   let bind = (@) in
 367   let option_default = [] in
 368   let mcode r x = [] in
 369   let donothing r k e = Common.union_set (Ast.get_isos e) (k e) in
 370   let doanything r k e = k e in
 371   V.combiner bind option_default
 372     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 373     donothing donothing donothing donothing donothing donothing donothing
 374     donothing donothing donothing donothing donothing donothing donothing
 375     donothing doanything
 376
 377 let collect_iso_info =
 378   let mcode x = x in
 379   let donothing r k e = k e in
 380   let rule_elem r k e =
 381     match Ast.unwrap e with
 382       Ast.DisjRuleElem(l) -> k e
 383     | _ ->
 384         let isos = collect_all_isos.V.combiner_rule_elem e in
 385         Ast.set_isos e isos in
 386   V.rebuilder
 387     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 388     donothing donothing donothing donothing donothing donothing donothing
 389     donothing donothing donothing donothing rule_elem donothing donothing
 390     donothing donothing
 391
 392 (* ----------------------------------------------------------------------- *)
 393
 394 let disj rules =
 395   List.map
 396     (function (mv,r) ->
 397       match r with
 398         Ast.ScriptRule _
 399       | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> (mv, r)
 400       | Ast.CocciRule (nm, rule_info, r, isexp, ruletype) ->
 401           let res =
 402             List.map
 403               (function x ->
 404                 let res = disj_all.V.rebuilder_top_level x in
 405                 if !Flag.track_iso_usage
 406                 then collect_iso_info.V.rebuilder_top_level res
 407                 else res)
 408               r in
 409           (mv, Ast.CocciRule (nm,rule_info,res,isexp,ruletype)))
 410     rules