parsing_cocci/.#disjdistr.ml.1.20

   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 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.ImplicitInt(_) -> [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.StructUnionName(kind,name) -> [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) -> List.concat (List.map disjexp exp_list)
 173   | Ast.NestExpr(expr_dots,whencode,multi) ->
 174       (* not sure what to do here, so ambiguities still possible *)
 175       [e]
 176   | Ast.Edots(dots,_) | Ast.Ecircles(dots,_) | Ast.Estars(dots,_) -> [e]
 177   | Ast.OptExp(exp) ->
 178       let exp = disjexp exp in
 179       List.map (function exp -> Ast.rewrap e (Ast.OptExp(exp))) exp
 180   | Ast.UniqueExp(exp) ->
 181       let exp = disjexp exp in
 182       List.map (function exp -> Ast.rewrap e (Ast.UniqueExp(exp))) exp
 183
 184 and disjparam p =
 185   match Ast.unwrap p with
 186     Ast.VoidParam(ty) -> [p] (* void is the only possible value *)
 187   | Ast.Param(ty,id) ->
 188       let ty = disjty ty in
 189       List.map (function ty -> Ast.rewrap p (Ast.Param(ty,id))) ty
 190   | Ast.MetaParam(_,_,_) | Ast.MetaParamList(_,_,_,_) | Ast.PComma(_) -> [p]
 191   | Ast.Pdots(dots) | Ast.Pcircles(dots) -> [p]
 192   | Ast.OptParam(param) ->
 193       let param = disjparam param in
 194       List.map (function param -> Ast.rewrap p (Ast.OptParam(param))) param
 195   | Ast.UniqueParam(param) ->
 196       let param = disjparam param in
 197       List.map (function param -> Ast.rewrap p (Ast.UniqueParam(param))) param
 198
 199 and disjini i =
 200   match Ast.unwrap i with
 201     Ast.InitExpr(exp) ->
 202       let exp = disjexp exp in
 203       List.map (function exp -> Ast.rewrap i (Ast.InitExpr(exp))) exp
 204   | Ast.InitList(lb,initlist,rb,whencode) ->
 205       List.map
 206         (function initlist ->
 207           Ast.rewrap i (Ast.InitList(lb,initlist,rb,whencode)))
 208         (disjmult disjini initlist)
 209   | Ast.InitGccDotName(dot,name,eq,ini) ->
 210       let ini = disjini ini in
 211       List.map
 212         (function ini -> Ast.rewrap i (Ast.InitGccDotName(dot,name,eq,ini)))
 213         ini
 214   | Ast.InitGccName(name,eq,ini) ->
 215       let ini = disjini ini in
 216       List.map
 217         (function ini -> Ast.rewrap i (Ast.InitGccName(name,eq,ini)))
 218         ini
 219   | Ast.InitGccIndex(lb,exp,rb,eq,ini) ->
 220       disjmult2 (disjexp exp) (disjini ini)
 221         (function exp -> function ini ->
 222           Ast.rewrap i (Ast.InitGccIndex(lb,exp,rb,eq,ini)))
 223   | Ast.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
 224       disjmult3 (disjexp exp1) (disjexp exp2) (disjini ini)
 225         (function exp1 -> function exp2 -> function ini ->
 226           Ast.rewrap i (Ast.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini)))
 227   | Ast.IComma(comma) -> [i]
 228   | Ast.OptIni(ini) ->
 229       let ini = disjini ini in
 230       List.map (function ini -> Ast.rewrap i (Ast.OptIni(ini))) ini
 231   | Ast.UniqueIni(ini) ->
 232       let ini = disjini ini in
 233       List.map (function ini -> Ast.rewrap i (Ast.UniqueIni(ini))) ini
 234
 235 and disjdecl d =
 236   match Ast.unwrap d with
 237     Ast.Init(stg,ty,id,eq,ini,sem) ->
 238       disjmult2 (disjty ty) (disjini ini)
 239         (function ty -> function ini ->
 240           Ast.rewrap d (Ast.Init(stg,ty,id,eq,ini,sem)))
 241   | Ast.UnInit(stg,ty,id,sem) ->
 242       let ty = disjty ty in
 243       List.map (function ty -> Ast.rewrap d (Ast.UnInit(stg,ty,id,sem))) ty
 244   | Ast.MacroDecl(name,lp,args,rp,sem) ->
 245       List.map
 246         (function args -> Ast.rewrap d (Ast.MacroDecl(name,lp,args,rp,sem)))
 247         (disjdots disjexp args)
 248   | Ast.TyDecl(ty,sem) ->
 249       let ty = disjty ty in
 250       List.map (function ty -> Ast.rewrap d (Ast.TyDecl(ty,sem))) ty
 251   | Ast.Typedef(stg,ty,id,sem) ->
 252       let ty = disjty ty in (* disj not allowed in id *)
 253       List.map (function ty -> Ast.rewrap d (Ast.Typedef(stg,ty,id,sem))) ty
 254   | Ast.DisjDecl(decls) -> List.concat (List.map disjdecl decls)
 255   | Ast.Ddots(_,_) | Ast.MetaDecl(_,_,_) -> [d]
 256   | Ast.OptDecl(decl) ->
 257       let decl = disjdecl decl in
 258       List.map (function decl -> Ast.rewrap d (Ast.OptDecl(decl))) decl
 259   | Ast.UniqueDecl(decl) ->
 260       let decl = disjdecl decl in
 261       List.map (function decl -> Ast.rewrap d (Ast.UniqueDecl(decl))) decl
 262
 263 let generic_orify_rule_elem f re exp rebuild =
 264   match f exp with
 265     [exp] -> re
 266   | orexps -> Ast.rewrap re (Ast.DisjRuleElem (List.map rebuild orexps))
 267
 268 let orify_rule_elem re exp rebuild =
 269   generic_orify_rule_elem disjexp re exp rebuild
 270
 271 let orify_rule_elem_ty = generic_orify_rule_elem disjty
 272 let orify_rule_elem_param = generic_orify_rule_elem disjparam
 273 let orify_rule_elem_decl = generic_orify_rule_elem disjdecl
 274
 275 let disj_rule_elem r k re =
 276   match Ast.unwrap re with
 277     Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
 278       generic_orify_rule_elem (disjdots disjparam) re params
 279         (function params ->
 280           Ast.rewrap re
 281             (Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp)))
 282   | Ast.Decl(bef,allminus,decl) ->
 283       orify_rule_elem_decl re decl
 284         (function decl -> Ast.rewrap re (Ast.Decl(bef,allminus,decl)))
 285   | Ast.SeqStart(brace) -> re
 286   | Ast.SeqEnd(brace) -> re
 287   | Ast.ExprStatement(exp,sem) ->
 288       orify_rule_elem re exp
 289         (function exp -> Ast.rewrap re (Ast.ExprStatement(exp,sem)))
 290   | Ast.IfHeader(iff,lp,exp,rp) ->
 291       orify_rule_elem re exp
 292         (function exp -> Ast.rewrap re (Ast.IfHeader(iff,lp,exp,rp)))
 293   | Ast.Else(els) -> re
 294   | Ast.WhileHeader(whl,lp,exp,rp) ->
 295       orify_rule_elem re exp
 296         (function exp -> Ast.rewrap re (Ast.WhileHeader(whl,lp,exp,rp)))
 297   | Ast.DoHeader(d) -> re
 298   | Ast.WhileTail(whl,lp,exp,rp,sem) ->
 299       orify_rule_elem re exp
 300         (function exp -> Ast.rewrap re (Ast.WhileTail(whl,lp,exp,rp,sem)))
 301   | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
 302       generic_orify_rule_elem (disjmult (disjoption disjexp)) re [e1;e2;e3]
 303         (function
 304             [exp1;exp2;exp3] ->
 305               Ast.rewrap re (Ast.ForHeader(fr,lp,exp1,sem1,exp2,sem2,exp3,rp))
 306           | _ -> failwith "not possible")
 307   | Ast.IteratorHeader(whl,lp,args,rp) ->
 308       generic_orify_rule_elem (disjdots disjexp) re args
 309         (function args -> Ast.rewrap re (Ast.IteratorHeader(whl,lp,args,rp)))
 310   | Ast.SwitchHeader(switch,lp,exp,rp) ->
 311       orify_rule_elem re exp
 312         (function exp -> Ast.rewrap re (Ast.SwitchHeader(switch,lp,exp,rp)))
 313   | Ast.Break(_,_) | Ast.Continue(_,_) | Ast.Label(_,_) | Ast.Goto(_,_,_)
 314   | Ast.Return(_,_) -> re
 315   | Ast.ReturnExpr(ret,exp,sem) ->
 316       orify_rule_elem re exp
 317         (function exp -> Ast.rewrap re (Ast.ReturnExpr(ret,exp,sem)))
 318   | Ast.MetaRuleElem(_,_,_) | Ast.MetaStmt(_,_,_,_)
 319   | Ast.MetaStmtList(_,_,_) -> re
 320   | Ast.Exp(exp) ->
 321       orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.Exp(exp)))
 322   | Ast.TopExp(exp) ->
 323       orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.TopExp(exp)))
 324   | Ast.Ty(ty) ->
 325       orify_rule_elem_ty re ty (function ty -> Ast.rewrap ty (Ast.Ty(ty)))
 326   | Ast.Include(inc,s) -> re
 327   | Ast.DefineHeader(def,id,params) -> re
 328   | Ast.Default(def,colon) -> re
 329   | Ast.Case(case,exp,colon) ->
 330       orify_rule_elem re exp
 331         (function exp -> Ast.rewrap re (Ast.Case(case,exp,colon)))
 332   | Ast.DisjRuleElem(_) -> failwith "not possible"
 333
 334 let disj_all =
 335   let mcode x = x in
 336   let donothing r k e = k e in
 337   V.rebuilder
 338     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 339     mcode
 340     donothing donothing donothing donothing
 341     donothing donothing donothing donothing donothing donothing donothing
 342     disj_rule_elem donothing donothing donothing donothing
 343
 344 (* ----------------------------------------------------------------------- *)
 345 (* collect iso information at the rule_elem level *)
 346
 347 let collect_all_isos =
 348   let bind = (@) in
 349   let option_default = [] in
 350   let mcode r x = [] in
 351   let donothing r k e = Common.union_set (Ast.get_isos e) (k e) in
 352   let doanything r k e = k e in
 353   V.combiner bind option_default
 354     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 355     mcode
 356     donothing donothing donothing donothing donothing donothing donothing
 357     donothing donothing donothing donothing donothing donothing donothing
 358     donothing doanything
 359
 360 let collect_iso_info =
 361   let mcode x = x in
 362   let donothing r k e = k e in
 363   let rule_elem r k e =
 364     match Ast.unwrap e with
 365       Ast.DisjRuleElem(l) -> k e
 366     | _ ->
 367         let isos = collect_all_isos.V.combiner_rule_elem e in
 368         Ast.set_isos e isos in
 369   V.rebuilder
 370     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 371     mcode
 372     donothing donothing donothing donothing donothing donothing donothing
 373     donothing donothing donothing donothing rule_elem donothing donothing
 374     donothing donothing
 375
 376 (* ----------------------------------------------------------------------- *)
 377
 378 let disj rules =
 379   List.map
 380     (function (mv,r) ->
 381       match r with
 382         Ast.ScriptRule _ -> (mv, r)
 383       | Ast.CocciRule (nm, rule_info, r, isexp) ->
 384       let res =
 385         List.map
 386           (function x ->
 387             let res = disj_all.V.rebuilder_top_level x in
 388             if !Flag.track_iso_usage
 389             then collect_iso_info.V.rebuilder_top_level res
 390             else res)
 391           r in
 392       (mv, Ast.CocciRule (nm,rule_info,res,isexp)))
 393     rules