| 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, Nicolas Palix |
| 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 | (* on the first pass, onlyModif is true, so we don't see all matched nodes, |
| 24 | only modified ones *) |
| 25 | |
| 26 | module Ast = Ast_cocci |
| 27 | module V = Visitor_ast |
| 28 | module CTL = Ast_ctl |
| 29 | |
| 30 | let mcode r (_,_,kind,_) = |
| 31 | match kind with |
| 32 | Ast.MINUS(_,_,_,_) -> true |
| 33 | | Ast.PLUS _ -> failwith "not possible" |
| 34 | | Ast.CONTEXT(_,info) -> not (info = Ast.NOTHING) |
| 35 | |
| 36 | let no_mcode _ _ = false |
| 37 | |
| 38 | let contains_modif used_after x = |
| 39 | if List.exists (function x -> List.mem x used_after) (Ast.get_fvs x) |
| 40 | then true |
| 41 | else |
| 42 | let bind x y = x or y in |
| 43 | let option_default = false in |
| 44 | let do_nothing r k e = k e in |
| 45 | let rule_elem r k re = |
| 46 | let res = k re in |
| 47 | match Ast.unwrap re with |
| 48 | Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) -> |
| 49 | bind (mcode r ((),(),bef,Ast.NoMetaPos)) res |
| 50 | | Ast.Decl(bef,_,decl) -> |
| 51 | bind (mcode r ((),(),bef,Ast.NoMetaPos)) res |
| 52 | | _ -> res in |
| 53 | let recursor = |
| 54 | V.combiner bind option_default |
| 55 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
| 56 | mcode |
| 57 | do_nothing do_nothing do_nothing do_nothing |
| 58 | do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing |
| 59 | do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in |
| 60 | recursor.V.combiner_rule_elem x |
| 61 | |
| 62 | (* contains an inherited metavariable or contains a constant *) |
| 63 | let contains_constant x = |
| 64 | match Ast.get_inherited x with |
| 65 | [] -> |
| 66 | let bind x y = x or y in |
| 67 | let option_default = false in |
| 68 | let do_nothing r k e = k e in |
| 69 | let mcode _ _ = false in |
| 70 | let ident r k i = |
| 71 | match Ast.unwrap i with |
| 72 | Ast.Id(name) -> true |
| 73 | | _ -> k i in |
| 74 | let expr r k e = |
| 75 | match Ast.unwrap e with |
| 76 | Ast.Constant(const) -> true |
| 77 | | _ -> k e in |
| 78 | let recursor = |
| 79 | V.combiner bind option_default |
| 80 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
| 81 | mcode |
| 82 | do_nothing do_nothing do_nothing do_nothing |
| 83 | ident expr do_nothing do_nothing do_nothing do_nothing |
| 84 | do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing in |
| 85 | recursor.V.combiner_rule_elem x |
| 86 | | _ -> true |
| 87 | |
| 88 | (* --------------------------------------------------------------------- *) |
| 89 | |
| 90 | let print_info = function |
| 91 | [] -> Printf.printf "no information\n" |
| 92 | | l -> |
| 93 | List.iter |
| 94 | (function disj -> |
| 95 | Printf.printf "one set of required things %d:\n" |
| 96 | (List.length disj); |
| 97 | List.iter |
| 98 | (function (_,thing) -> |
| 99 | Printf.printf "%s\n" |
| 100 | (Pretty_print_cocci.rule_elem_to_string thing)) |
| 101 | disj;) |
| 102 | l |
| 103 | |
| 104 | (* --------------------------------------------------------------------- *) |
| 105 | |
| 106 | (* drop all distinguishing information from a term *) |
| 107 | let strip = |
| 108 | let do_nothing r k e = Ast.make_term (Ast.unwrap (k e)) in |
| 109 | let do_absolutely_nothing r k e = k e in |
| 110 | let mcode m = Ast.make_mcode(Ast.unwrap_mcode m) in |
| 111 | let rule_elem r k re = |
| 112 | let res = do_nothing r k re in |
| 113 | let no_mcode = Ast.CONTEXT(Ast.NoPos,Ast.NOTHING) in |
| 114 | match Ast.unwrap res with |
| 115 | Ast.FunHeader(bef,b,fninfo,name,lp,params,rp) -> |
| 116 | Ast.rewrap res |
| 117 | (Ast.FunHeader(no_mcode,b,fninfo,name,lp,params,rp)) |
| 118 | | Ast.Decl(bef,b,decl) -> Ast.rewrap res (Ast.Decl(no_mcode,b,decl)) |
| 119 | | _ -> res in |
| 120 | let recursor = |
| 121 | V.rebuilder |
| 122 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
| 123 | do_nothing do_nothing do_nothing do_nothing |
| 124 | do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing |
| 125 | do_nothing rule_elem do_nothing do_nothing |
| 126 | do_nothing do_absolutely_nothing in |
| 127 | recursor.V.rebuilder_rule_elem |
| 128 | |
| 129 | (* --------------------------------------------------------------------- *) |
| 130 | |
| 131 | let disj l1 l2 = l1 l2 |
| 132 | |
| 133 | let rec conj xs ys = |
| 134 | match (xs,ys) with |
| 135 | ([],_) -> ys |
| 136 | | (_,[]) -> xs |
| 137 | | _ -> |
| 138 | List.fold_left |
| 139 | (function prev -> |
| 140 | function x -> |
| 141 | List.fold_left |
| 142 | (function prev -> |
| 143 | function cur -> |
| 144 | let cur_res = (List.sort compare (Common.union_set x cur)) in |
| 145 | cur_res :: |
| 146 | (List.filter |
| 147 | (function x -> not (Common.include_set cur_res x)) |
| 148 | prev)) |
| 149 | prev ys) |
| 150 | [] xs |
| 151 | |
| 152 | let conj_wrapped x l = conj [List.map (function x -> (1,strip x)) x] l |
| 153 | |
| 154 | (* --------------------------------------------------------------------- *) |
| 155 | (* the main translation loop *) |
| 156 | |
| 157 | let rule_elem re = |
| 158 | match Ast.unwrap re with |
| 159 | Ast.DisjRuleElem(res) -> [[(List.length res,strip re)]] |
| 160 | | _ -> [[(1,strip re)]] |
| 161 | |
| 162 | let conj_one testfn x l = |
| 163 | if testfn x |
| 164 | then conj (rule_elem x) l |
| 165 | else l |
| 166 | |
| 167 | let rec statement_list testfn mcode tail stmt_list : 'a list list = |
| 168 | match Ast.unwrap stmt_list with |
| 169 | Ast.DOTS(x) | Ast.CIRCLES(x) | Ast.STARS(x) -> |
| 170 | (match List.rev x with |
| 171 | [] -> [] |
| 172 | | last::rest -> |
| 173 | List.fold_right |
| 174 | (function cur -> |
| 175 | function rest -> |
| 176 | conj (statement testfn mcode false cur) rest) |
| 177 | rest (statement testfn mcode tail last)) |
| 178 | |
| 179 | and statement testfn mcode tail stmt : 'a list list = |
| 180 | match Ast.unwrap stmt with |
| 181 | Ast.Atomic(ast) -> |
| 182 | (match Ast.unwrap ast with |
| 183 | (* modifications on return are managed in some other way *) |
| 184 | Ast.Return(_,_) | Ast.ReturnExpr(_,_,_) when tail -> [] |
| 185 | | _ -> if testfn ast then rule_elem ast else []) |
| 186 | | Ast.Seq(lbrace,body,rbrace) -> |
| 187 | let body_info = statement_list testfn mcode tail body in |
| 188 | if testfn lbrace or testfn rbrace |
| 189 | then conj_wrapped [lbrace;rbrace] body_info |
| 190 | else body_info |
| 191 | |
| 192 | | Ast.IfThen(header,branch,(_,_,_,aft)) |
| 193 | | Ast.While(header,branch,(_,_,_,aft)) |
| 194 | | Ast.For(header,branch,(_,_,_,aft)) |
| 195 | | Ast.Iterator(header,branch,(_,_,_,aft)) -> |
| 196 | if testfn header or mcode () ((),(),aft,Ast.NoMetaPos) |
| 197 | then conj (rule_elem header) (statement testfn mcode tail branch) |
| 198 | else statement testfn mcode tail branch |
| 199 | |
| 200 | | Ast.Switch(header,lb,decls,cases,rb) -> |
| 201 | let body_info = |
| 202 | conj |
| 203 | (statement_list testfn mcode false decls) |
| 204 | (case_lines testfn mcode tail cases) in |
| 205 | if testfn header or testfn lb or testfn rb |
| 206 | then conj (rule_elem header) body_info |
| 207 | else body_info |
| 208 | |
| 209 | | Ast.IfThenElse(ifheader,branch1,els,branch2,(_,_,_,aft)) -> |
| 210 | let branches = |
| 211 | conj |
| 212 | (statement testfn mcode tail branch1) |
| 213 | (statement testfn mcode tail branch2) in |
| 214 | if testfn ifheader or mcode () ((),(),aft,Ast.NoMetaPos) |
| 215 | then conj (rule_elem ifheader) branches |
| 216 | else branches |
| 217 | |
| 218 | | Ast.Disj(stmt_dots_list) -> |
| 219 | let processed = |
| 220 | List.map (statement_list testfn mcode tail) stmt_dots_list in |
| 221 | (* if one branch gives no information, then we have to take anything *) |
| 222 | if List.exists (function [] -> true | _ -> false) processed |
| 223 | then [] |
| 224 | else Common.union_all processed |
| 225 | |
| 226 | | Ast.Nest(stmt_dots,whencode,true,_,_) -> |
| 227 | statement_list testfn mcode false stmt_dots |
| 228 | |
| 229 | | Ast.Nest(stmt_dots,whencode,false,_,_) -> [] |
| 230 | |
| 231 | | Ast.Dots(_,whencodes,_,_) -> [] |
| 232 | |
| 233 | | Ast.FunDecl(header,lbrace,body,rbrace) -> |
| 234 | let body_info = statement_list testfn mcode true body in |
| 235 | if testfn header or testfn lbrace or testfn rbrace |
| 236 | then conj (rule_elem header) body_info |
| 237 | else body_info |
| 238 | |
| 239 | | Ast.Define(header,body) -> |
| 240 | conj_one testfn header (statement_list testfn mcode tail body) |
| 241 | |
| 242 | | Ast.OptStm(stm) -> [] |
| 243 | |
| 244 | | Ast.UniqueStm(stm) -> statement testfn mcode tail stm |
| 245 | |
| 246 | | _ -> failwith "not supported" |
| 247 | |
| 248 | and case_lines testfn mcode tail cases = |
| 249 | match cases with |
| 250 | [] -> [] |
| 251 | | last::rest -> |
| 252 | List.fold_right |
| 253 | (function cur -> |
| 254 | function rest -> |
| 255 | conj (case_line testfn mcode false cur) rest) |
| 256 | rest (case_line testfn mcode tail last) |
| 257 | |
| 258 | and case_line testfn mcode tail case = |
| 259 | match Ast.unwrap case with |
| 260 | Ast.CaseLine(header,code) -> |
| 261 | conj_one testfn header (statement_list testfn mcode tail code) |
| 262 | |
| 263 | | Ast.OptCase(case) -> [] |
| 264 | |
| 265 | (* --------------------------------------------------------------------- *) |
| 266 | (* Function declaration *) |
| 267 | |
| 268 | let top_level testfn mcode t : 'a list list = |
| 269 | match Ast.unwrap t with |
| 270 | Ast.FILEINFO(old_file,new_file) -> failwith "not supported fileinfo" |
| 271 | | Ast.DECL(stmt) -> statement testfn mcode false stmt |
| 272 | | Ast.CODE(stmt_dots) -> statement_list testfn mcode false stmt_dots |
| 273 | | Ast.ERRORWORDS(exps) -> failwith "not supported errorwords" |
| 274 | |
| 275 | (* --------------------------------------------------------------------- *) |
| 276 | (* Entry points *) |
| 277 | |
| 278 | let debug = false |
| 279 | |
| 280 | (* if we end up with nothing, we assume that this rule is only here because |
| 281 | someone depends on it, and thus we try again with testfn as contains_modif. |
| 282 | Alternatively, we could check that this rule is mentioned in some |
| 283 | dependency, but that would be a little more work, and doesn't seem |
| 284 | worthwhile. *) |
| 285 | |
| 286 | (* lists are sorted such that smaller DisjRuleElem are first, because they |
| 287 | are cheaper to test *) |
| 288 | |
| 289 | let asttomemberz (_,_,l) used_after = |
| 290 | let process_one (l : (int * Ast_cocci.rule_elem) list list) = |
| 291 | if debug |
| 292 | then print_info l; |
| 293 | List.map |
| 294 | (function info -> |
| 295 | let info = |
| 296 | List.sort (function (n1,_) -> function (n2,_) -> compare n1 n2) |
| 297 | info in |
| 298 | List.map (function (_,x) -> (Lib_engine.Match(x),CTL.Control)) info) |
| 299 | l in |
| 300 | List.map2 |
| 301 | (function min -> function (max,big_max) -> |
| 302 | match min with |
| 303 | [] -> |
| 304 | (match max() with |
| 305 | [] -> process_one (big_max()) |
| 306 | | max -> process_one max) |
| 307 | | _ -> process_one min) |
| 308 | (List.map (top_level contains_constant no_mcode) l) |
| 309 | (List.combine |
| 310 | (List.map2 |
| 311 | (function x -> function ua -> function _ -> |
| 312 | top_level (contains_modif ua) mcode x) |
| 313 | l used_after) |
| 314 | (List.map |
| 315 | (function x -> function _ -> |
| 316 | top_level (function _ -> true) no_mcode x) |
| 317 | l)) |
| 318 | |
| 319 | let asttomember r used_after = |
| 320 | match r with |
| 321 | Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> [] |
| 322 | | Ast.CocciRule (a,b,c,_,_) -> asttomemberz (a,b,c) used_after |
| 323 | |