engine/postprocess_transinfo.ml

   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 (* two goals: first drop from the environments things that are not used,
  24    and second prompt for the names of fresh variables that are used *)
  25
  26 (* have to add in the whole inherited env because inherited variables are
  27 not returned by get_fvs.  It would be better if that were the case, but
  28 since at the moment I think we can only inherit one value per variable,
  29 perhaps it doesn't matter - these bindings will always be the same no matter
  30 how we reached a particular match *)
  31
  32 module Ast = Ast_cocci
  33
  34 let extra_counter = ref 0
  35 let get_extra _ =
  36   let ctr = !extra_counter in
  37   extra_counter := !extra_counter + 1;
  38   "__extra_counter__"^(string_of_int ctr)
  39
  40 let get_seeded seed =
  41   let ctr = !extra_counter in
  42   extra_counter := !extra_counter + 1;
  43   seed^(string_of_int ctr)
  44
  45 let read_fresh_id _ =
  46   try
  47     let s = read_line () in
  48     match Parse_c.tokens_of_string s with
  49       [Parser_c.TIdent _; Parser_c.EOF _] -> s
  50     | [Parser_c.EOF _] -> get_extra()
  51     | _ -> failwith ("wrong fresh id: " ^ s)
  52   with End_of_file -> get_extra()
  53
  54 let get_vars = function
  55     Lib_engine.Match(re) -> (Ast.get_fvs re, Ast.get_fresh re)
  56   | _ -> ([],[])
  57
  58 let string2val str = Lib_engine.NormalMetaVal(Ast_c.MetaIdVal(str))
  59
  60 (* ----------------------------------------------------------------------- *)
  61 (* Get values for fresh variables *)
  62
  63 let process_tree inherited_env l =
  64   let (all_fresh,local_freshs,new_triples) =
  65     List.fold_left
  66       (function (all_fresh,local_freshs,new_triples) ->
  67         function (node,env,pred) ->
  68           let (other,fresh) = get_vars pred in
  69           let env = List.filter (function (x,_) -> List.mem x other) env in
  70           (Common.union_set fresh all_fresh,
  71            fresh::local_freshs,
  72            (node,env@inherited_env,pred)::new_triples))
  73       ([],[],[]) l in
  74   let local_freshs = List.rev local_freshs in
  75   let new_triples = List.rev new_triples in
  76   let fresh_env =
  77     List.map
  78       (function
  79           ((r,n) as fresh,None) ->
  80             Printf.printf "%s: name for %s: " r n; (* not debugging code!!! *)
  81             flush stdout;
  82             (fresh,string2val(read_fresh_id()))
  83         | ((r,n) as fresh,Some seed) ->
  84             (fresh,string2val(get_seeded seed)))
  85       all_fresh in
  86   let (_,res) =
  87     List.split
  88       (List.fold_left
  89          (function freshs_node_env_preds ->
  90            function (fresh,_) as elem ->
  91              List.map
  92                (function (freshs,((node,env,pred) as cur)) ->
  93                  try
  94                    let _ = List.assoc fresh freshs in
  95                    (freshs,(node,elem::env,pred))
  96                  with Not_found -> (freshs,cur))
  97                freshs_node_env_preds)
  98          (List.combine local_freshs new_triples)
  99          fresh_env) in
 100   (List.rev res, fresh_env)
 101
 102 (* ----------------------------------------------------------------------- *)
 103 (* Create the environment to be used afterwards *)
 104
 105 let collect_used_after used_after envs =
 106   List.map (List.filter (function (v,vl) -> List.mem v used_after)) envs
 107
 108 (* ----------------------------------------------------------------------- *)
 109 (* entry point *)
 110
 111 let process used_after inherited_env l =
 112   extra_counter := 0;
 113   let (trees, fresh_envs) =
 114     List.split (List.map (process_tree inherited_env) l) in
 115   (Common.uniq(List.concat trees), collect_used_after used_after fresh_envs)