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 disjident e =
 109   match Ast.unwrap e with
 110     Ast.DisjId(id_list) -> List.concat (List.map disjident id_list)
 111   | Ast.OptIdent(id) ->
 112       let id = disjident id in
 113       List.map (function id -> Ast.rewrap e (Ast.OptIdent(id))) id
 114   | Ast.UniqueIdent(id) ->
 115       let id = disjident id in
 116       List.map (function id -> Ast.rewrap e (Ast.UniqueIdent(id))) id
 117   | _ -> [e]
 118
 119 and disjexp e =
 120   match Ast.unwrap e with
 121     Ast.Ident(_) | Ast.Constant(_) -> [e] (* even Ident can't contain disj *)
 122   | Ast.FunCall(fn,lp,args,rp) ->
 123       disjmult2 (disjexp fn) (disjdots disjexp args)
 124         (function fn -> function args ->
 125           Ast.rewrap e (Ast.FunCall(fn,lp,args,rp)))
 126   | Ast.Assignment(left,op,right,simple) ->
 127       disjmult2 (disjexp left) (disjexp right)
 128         (function left -> function right ->
 129           Ast.rewrap e (Ast.Assignment(left,op,right,simple)))
 130   | Ast.CondExpr(exp1,why,Some exp2,colon,exp3) ->
 131       let res = disjmult disjexp [exp1;exp2;exp3] in
 132       List.map
 133         (function
 134             [exp1;exp2;exp3] ->
 135               Ast.rewrap e (Ast.CondExpr(exp1,why,Some exp2,colon,exp3))
 136           | _ -> failwith "not possible")
 137         res
 138   | Ast.CondExpr(exp1,why,None,colon,exp3) ->
 139       disjmult2 (disjexp exp1) (disjexp exp3)
 140         (function exp1 -> function exp3 ->
 141           Ast.rewrap e (Ast.CondExpr(exp1,why,None,colon,exp3)))
 142   | Ast.Postfix(exp,op) ->
 143       let exp = disjexp exp in
 144       List.map (function exp -> Ast.rewrap e (Ast.Postfix(exp,op))) exp
 145   | Ast.Infix(exp,op) ->
 146       let exp = disjexp exp in
 147       List.map (function exp -> Ast.rewrap e (Ast.Infix(exp,op))) exp
 148   | Ast.Unary(exp,op) ->
 149       let exp = disjexp exp in
 150       List.map (function exp -> Ast.rewrap e (Ast.Unary(exp,op))) exp
 151   | Ast.Binary(left,op,right) ->
 152       disjmult2 (disjexp left) (disjexp right)
 153         (function left -> function right ->
 154           Ast.rewrap e (Ast.Binary(left,op,right)))
 155   | Ast.Nested(exp,op,right) ->
 156       (* disj not possible in right *)
 157       let exp = disjexp exp in
 158       List.map (function exp -> Ast.rewrap e (Ast.Nested(exp,op,right))) exp
 159   | Ast.Paren(lp,exp,rp) ->
 160       let exp = disjexp exp in
 161       List.map (function exp -> Ast.rewrap e (Ast.Paren(lp,exp,rp))) exp
 162   | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
 163       disjmult2 (disjexp exp1) (disjexp exp2)
 164         (function exp1 -> function exp2 ->
 165           Ast.rewrap e (Ast.ArrayAccess(exp1,lb,exp2,rb)))
 166   | Ast.RecordAccess(exp,pt,field) ->
 167       let exp = disjexp exp in
 168       List.map
 169         (function exp -> Ast.rewrap e (Ast.RecordAccess(exp,pt,field))) exp
 170   | Ast.RecordPtAccess(exp,ar,field) ->
 171       let exp = disjexp exp in
 172       List.map
 173         (function exp -> Ast.rewrap e (Ast.RecordPtAccess(exp,ar,field))) exp
 174   | Ast.Cast(lp,ty,rp,exp) ->
 175       disjmult2 (disjty ty) (disjexp exp)
 176         (function ty -> function exp -> Ast.rewrap e (Ast.Cast(lp,ty,rp,exp)))
 177   | Ast.SizeOfExpr(szf,exp) ->
 178       let exp = disjexp exp in
 179       List.map (function exp -> Ast.rewrap e (Ast.SizeOfExpr(szf,exp))) exp
 180   | Ast.SizeOfType(szf,lp,ty,rp) ->
 181       let ty = disjty ty in
 182       List.map
 183         (function ty -> Ast.rewrap e (Ast.SizeOfType(szf,lp,ty,rp))) ty
 184   | Ast.TypeExp(ty) ->
 185       let ty = disjty ty in
 186       List.map (function ty -> Ast.rewrap e (Ast.TypeExp(ty))) ty
 187   | Ast.MetaErr(_,_,_,_) | Ast.MetaExpr(_,_,_,_,_,_)
 188   | Ast.MetaExprList(_,_,_,_) | Ast.EComma(_) -> [e]
 189   | Ast.DisjExpr(exp_list) -> List.concat (List.map disjexp exp_list)
 190   | Ast.NestExpr(starter,expr_dots,ender,whencode,multi) ->
 191       (* not sure what to do here, so ambiguities still possible *)
 192       [e]
 193   | Ast.Edots(dots,_) | Ast.Ecircles(dots,_) | Ast.Estars(dots,_) -> [e]
 194   | Ast.OptExp(exp) ->
 195       let exp = disjexp exp in
 196       List.map (function exp -> Ast.rewrap e (Ast.OptExp(exp))) exp
 197   | Ast.UniqueExp(exp) ->
 198       let exp = disjexp exp in
 199       List.map (function exp -> Ast.rewrap e (Ast.UniqueExp(exp))) exp
 200
 201 and disjparam p =
 202   match Ast.unwrap p with
 203     Ast.VoidParam(ty) -> [p] (* void is the only possible value *)
 204   | Ast.Param(ty,id) ->
 205       let ty = disjty ty in
 206       List.map (function ty -> Ast.rewrap p (Ast.Param(ty,id))) ty
 207   | Ast.MetaParam(_,_,_) | Ast.MetaParamList(_,_,_,_) | Ast.PComma(_) -> [p]
 208   | Ast.Pdots(dots) | Ast.Pcircles(dots) -> [p]
 209   | Ast.OptParam(param) ->
 210       let param = disjparam param in
 211       List.map (function param -> Ast.rewrap p (Ast.OptParam(param))) param
 212   | Ast.UniqueParam(param) ->
 213       let param = disjparam param in
 214       List.map (function param -> Ast.rewrap p (Ast.UniqueParam(param))) param
 215
 216 and disjini i =
 217   match Ast.unwrap i with
 218     Ast.MetaInit(_,_,_) | Ast.MetaInitList(_,_,_,_) -> [i]
 219   | Ast.InitExpr(exp) ->
 220       let exp = disjexp exp in
 221       List.map (function exp -> Ast.rewrap i (Ast.InitExpr(exp))) exp
 222   | Ast.ArInitList(lb,initlist,rb) ->
 223       List.map
 224         (function initlist ->
 225           Ast.rewrap i (Ast.ArInitList(lb,initlist,rb)))
 226         (disjdots disjini initlist)
 227   | Ast.StrInitList(allminus,lb,initlist,rb,whencode) ->
 228       List.map
 229         (function initlist ->
 230           Ast.rewrap i (Ast.StrInitList(allminus,lb,initlist,rb,whencode)))
 231         (disjmult disjini initlist)
 232   | Ast.InitGccExt(designators,eq,ini) ->
 233       let designators = disjmult designator designators in
 234       let ini = disjini ini in
 235       disjmult2 designators ini
 236         (function designators -> function ini ->
 237           Ast.rewrap i (Ast.InitGccExt(designators,eq,ini)))
 238   | Ast.InitGccName(name,eq,ini) ->
 239       let ini = disjini ini in
 240       List.map
 241         (function ini -> Ast.rewrap i (Ast.InitGccName(name,eq,ini)))
 242         ini
 243   | Ast.IComma(comma) -> [i]
 244   | Ast.Idots(dots,_) -> [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.MetaDecl(_,_,_) | Ast.MetaField(_,_,_)
 265   | Ast.MetaFieldList(_,_,_,_) -> [d]
 266   | Ast.Init(stg,ty,id,eq,ini,sem) ->
 267       disjmult2 (disjty ty) (disjini ini)
 268         (function ty -> function ini ->
 269           Ast.rewrap d (Ast.Init(stg,ty,id,eq,ini,sem)))
 270   | Ast.UnInit(stg,ty,id,sem) ->
 271       let ty = disjty ty in
 272       List.map (function ty -> Ast.rewrap d (Ast.UnInit(stg,ty,id,sem))) ty
 273   | Ast.MacroDecl(name,lp,args,rp,sem) ->
 274       List.map
 275         (function args -> Ast.rewrap d (Ast.MacroDecl(name,lp,args,rp,sem)))
 276         (disjdots disjexp args)
 277   | Ast.TyDecl(ty,sem) ->
 278       let ty = disjty ty in
 279       List.map (function ty -> Ast.rewrap d (Ast.TyDecl(ty,sem))) ty
 280   | Ast.Typedef(stg,ty,id,sem) ->
 281       let ty = disjty ty in (* disj not allowed in id *)
 282       List.map (function ty -> Ast.rewrap d (Ast.Typedef(stg,ty,id,sem))) ty
 283   | Ast.DisjDecl(decls) -> List.concat (List.map disjdecl decls)
 284   | Ast.Ddots(_,_) -> [d]
 285   | Ast.OptDecl(decl) ->
 286       let decl = disjdecl decl in
 287       List.map (function decl -> Ast.rewrap d (Ast.OptDecl(decl))) decl
 288   | Ast.UniqueDecl(decl) ->
 289       let decl = disjdecl decl in
 290       List.map (function decl -> Ast.rewrap d (Ast.UniqueDecl(decl))) decl
 291
 292 let generic_orify_rule_elem f re exp rebuild =
 293   match f exp with
 294     [exp] -> re
 295   | orexps -> Ast.rewrap re (Ast.DisjRuleElem (List.map rebuild orexps))
 296
 297 let orify_rule_elem re exp rebuild =
 298   generic_orify_rule_elem disjexp re exp rebuild
 299
 300 let orify_rule_elem_ty = generic_orify_rule_elem disjty
 301 let orify_rule_elem_param = generic_orify_rule_elem disjparam
 302 let orify_rule_elem_decl = generic_orify_rule_elem disjdecl
 303 let orify_rule_elem_ini = generic_orify_rule_elem disjini
 304
 305 let rec disj_rule_elem r k re =
 306   match Ast.unwrap re with
 307     Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
 308       generic_orify_rule_elem (disjdots disjparam) re params
 309         (function params ->
 310           Ast.rewrap re
 311             (Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp)))
 312   | Ast.Decl(bef,allminus,decl) ->
 313       orify_rule_elem_decl re decl
 314         (function decl -> Ast.rewrap re (Ast.Decl(bef,allminus,decl)))
 315   | Ast.SeqStart(brace) -> re
 316   | Ast.SeqEnd(brace) -> re
 317   | Ast.ExprStatement(Some exp,sem) ->
 318       orify_rule_elem re exp
 319         (function exp -> Ast.rewrap re (Ast.ExprStatement(Some exp,sem)))
 320   | Ast.ExprStatement(None,sem) -> re
 321   | Ast.IfHeader(iff,lp,exp,rp) ->
 322       orify_rule_elem re exp
 323         (function exp -> Ast.rewrap re (Ast.IfHeader(iff,lp,exp,rp)))
 324   | Ast.Else(els) -> re
 325   | Ast.WhileHeader(whl,lp,exp,rp) ->
 326       orify_rule_elem re exp
 327         (function exp -> Ast.rewrap re (Ast.WhileHeader(whl,lp,exp,rp)))
 328   | Ast.DoHeader(d) -> re
 329   | Ast.WhileTail(whl,lp,exp,rp,sem) ->
 330       orify_rule_elem re exp
 331         (function exp -> Ast.rewrap re (Ast.WhileTail(whl,lp,exp,rp,sem)))
 332   | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
 333       generic_orify_rule_elem (disjmult (disjoption disjexp)) re [e1;e2;e3]
 334         (function
 335             [exp1;exp2;exp3] ->
 336               Ast.rewrap re (Ast.ForHeader(fr,lp,exp1,sem1,exp2,sem2,exp3,rp))
 337           | _ -> failwith "not possible")
 338   | Ast.IteratorHeader(whl,lp,args,rp) ->
 339       generic_orify_rule_elem (disjdots disjexp) re args
 340         (function args -> Ast.rewrap re (Ast.IteratorHeader(whl,lp,args,rp)))
 341   | Ast.SwitchHeader(switch,lp,exp,rp) ->
 342       orify_rule_elem re exp
 343         (function exp -> Ast.rewrap re (Ast.SwitchHeader(switch,lp,exp,rp)))
 344   | Ast.Break(_,_) | Ast.Continue(_,_) | Ast.Label(_,_) | Ast.Goto(_,_,_)
 345   | Ast.Return(_,_) -> re
 346   | Ast.ReturnExpr(ret,exp,sem) ->
 347       orify_rule_elem re exp
 348         (function exp -> Ast.rewrap re (Ast.ReturnExpr(ret,exp,sem)))
 349   | Ast.MetaRuleElem(_,_,_) | Ast.MetaStmt(_,_,_,_)
 350   | Ast.MetaStmtList(_,_,_) -> re
 351   | Ast.Exp(exp) ->
 352       orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.Exp(exp)))
 353   | Ast.TopExp(exp) ->
 354       orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.TopExp(exp)))
 355   | Ast.Ty(ty) ->
 356       orify_rule_elem_ty re ty (function ty -> Ast.rewrap ty (Ast.Ty(ty)))
 357   | Ast.TopInit(init) ->
 358       orify_rule_elem_ini re init
 359         (function init -> Ast.rewrap init (Ast.TopInit(init)))
 360   | Ast.Include(inc,s) -> re
 361   | Ast.Undef(def,id) -> re
 362   | Ast.DefineHeader(def,id,params) -> re
 363   | Ast.Default(def,colon) -> re
 364   | Ast.Case(case,exp,colon) ->
 365       orify_rule_elem re exp
 366         (function exp -> Ast.rewrap re (Ast.Case(case,exp,colon)))
 367   | Ast.DisjRuleElem(l) ->
 368       (* only case lines *)
 369       Ast.rewrap re(Ast.DisjRuleElem(List.map (disj_rule_elem r k) l))
 370
 371 let disj_all =
 372   let mcode x = x in
 373   let donothing r k e = k e in
 374   V.rebuilder
 375     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 376     donothing donothing donothing donothing donothing
 377     donothing donothing donothing donothing donothing donothing donothing
 378     disj_rule_elem donothing donothing donothing donothing
 379
 380 (* ----------------------------------------------------------------------- *)
 381 (* collect iso information at the rule_elem level *)
 382
 383 let collect_all_isos =
 384   let bind = (@) in
 385   let option_default = [] in
 386   let mcode r x = [] in
 387   let donothing r k e = Common.union_set (Ast.get_isos e) (k e) in
 388   let doanything r k e = k e in
 389   V.combiner bind option_default
 390     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 391     donothing donothing donothing donothing donothing donothing donothing
 392     donothing donothing donothing donothing donothing donothing donothing
 393     donothing donothing doanything
 394
 395 let collect_iso_info =
 396   let mcode x = x in
 397   let donothing r k e = k e in
 398   let rule_elem r k e =
 399     match Ast.unwrap e with
 400       Ast.DisjRuleElem(l) -> k e
 401     | _ ->
 402         let isos = collect_all_isos.V.combiner_rule_elem e in
 403         Ast.set_isos e isos in
 404   V.rebuilder
 405     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 406     donothing donothing donothing donothing donothing donothing donothing
 407      donothing
 408     donothing donothing donothing donothing rule_elem donothing donothing
 409     donothing donothing
 410
 411 (* ----------------------------------------------------------------------- *)
 412
 413 let disj rules =
 414   List.map
 415     (function (mv,r) ->
 416       match r with
 417         Ast.ScriptRule _
 418       | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> (mv, r)
 419       | Ast.CocciRule (nm, rule_info, r, isexp, ruletype) ->
 420           let res =
 421             List.map
 422               (function x ->
 423                 let res = disj_all.V.rebuilder_top_level x in
 424                 if !Flag.track_iso_usage
 425                 then collect_iso_info.V.rebuilder_top_level res
 426                 else res)
 427               r in
 428           (mv, Ast.CocciRule (nm,rule_info,res,isexp,ruletype)))
 429     rules