engine/asttomember.ml

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