parsing_cocci/disjdistr.ml

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