parsing_cocci/.#disjdistr.ml.1.27

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