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