parsing_cocci/disjdistr.ml

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