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