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