engine/postprocess_transinfo.ml

   1 (*
   2 * Copyright 2005-2008, 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 read_fresh_id () =
  41   try
  42     let s = read_line () in
  43     match Parse_c.tokens_of_string s with
  44       [Parser_c.TIdent _; Parser_c.EOF _] -> s
  45     | _ -> failwith ("wrong fresh id: " ^ s)
  46   with End_of_file -> get_extra()
  47
  48 let get_vars = function
  49     Lib_engine.Match(re) -> (Ast.get_fvs re, Ast.get_fresh re)
  50   | _ -> ([],[])
  51
  52 let string2val str = Lib_engine.NormalMetaVal(Ast_c.MetaIdVal(str))
  53
  54 (* ----------------------------------------------------------------------- *)
  55 (* Get values for fresh variables *)
  56
  57 let process_tree inherited_env l =
  58   let (all_fresh,local_freshs,new_triples) =
  59     List.fold_left
  60       (function (all_fresh,local_freshs,new_triples) ->
  61         function (node,env,pred) ->
  62           let (other,fresh) = get_vars pred in
  63           let env = List.filter (function (x,_) -> List.mem x other) env in
  64           (Common.union_set fresh all_fresh,
  65            fresh::local_freshs,
  66            (node,env@inherited_env,pred)::new_triples))
  67       ([],[],[]) l in
  68   let local_freshs = List.rev local_freshs in
  69   let new_triples = List.rev new_triples in
  70   let fresh_env =
  71     List.map
  72       (function ((r,n) as fresh) ->
  73         Printf.printf "%s: name for %s: " r n; (* not debugging code!!! *)
  74         flush stdout;
  75         (fresh,string2val(read_fresh_id())))
  76       all_fresh in
  77   let (_,res) =
  78     List.split
  79       (List.fold_left
  80          (function freshs_node_env_preds ->
  81            function (fresh,_) as elem ->
  82              List.map
  83                (function (freshs,((node,env,pred) as cur)) ->
  84                  if List.mem fresh freshs
  85                  then (freshs,(node,elem::env,pred))
  86                  else (freshs,cur))
  87                freshs_node_env_preds)
  88          (List.combine local_freshs new_triples)
  89          fresh_env) in
  90   (List.rev res, fresh_env)
  91
  92 (* ----------------------------------------------------------------------- *)
  93 (* Create the environment to be used afterwards *)
  94
  95 let collect_used_after used_after envs =
  96   List.map (List.filter (function (v,vl) -> List.mem v used_after)) envs
  97
  98 (* ----------------------------------------------------------------------- *)
  99 (* entry point *)
 100
 101 let process used_after inherited_env l =
 102   extra_counter := 0;
 103   let (trees, fresh_envs) =
 104     List.split (List.map (process_tree inherited_env) l) in
 105   (Common.uniq(List.concat trees), collect_used_after used_after fresh_envs)