parsing_cocci/iso_compile.ml

   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 (*
  26  * Copyright 2010, INRIA, University of Copenhagen
  27  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  28  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  29  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  30  * This file is part of Coccinelle.
  31  *
  32  * Coccinelle is free software: you can redistribute it and/or modify
  33  * it under the terms of the GNU General Public License as published by
  34  * the Free Software Foundation, according to version 2 of the License.
  35  *
  36  * Coccinelle is distributed in the hope that it will be useful,
  37  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  38  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  39  * GNU General Public License for more details.
  40  *
  41  * You should have received a copy of the GNU General Public License
  42  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  43  *
  44  * The authors reserve the right to distribute this or future versions of
  45  * Coccinelle under other licenses.
  46  *)
  47
  48
  49 module V0 = Visitor_ast0
  50 module VT0 = Visitor_ast0_types
  51 module Ast0 = Ast0_cocci
  52 module Ast = Ast_cocci
  53
  54 (* Detects where position variables can be present in the match of an
  55 isomorpshims.  This is allowed if all elements of an isomorphism have only
  56 one token or if we can somehow match up equal tokens of all of the
  57 isomorphic variants. *)
  58
  59 let sequence_tokens =
  60   let mcode x =
  61     (* sort of unpleasant to convert the token representation to a string
  62        but we can't make a list of mcodes otherwise because the types are all
  63        different *)
  64     [(Common.dump (Ast0.unwrap_mcode x),Ast0.get_pos_ref x)] in
  65   let donothing r k e = k e in
  66   let bind x y = x @ y in
  67   let option_default = [] in
  68   V0.flat_combiner bind option_default
  69     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
  70     donothing donothing donothing donothing donothing donothing
  71     donothing donothing
  72     donothing donothing donothing donothing donothing donothing donothing
  73
  74 (* In general, we will get a list of lists:
  75
  76 [[tokens1;tokens2;tokens3];[tokens4;tokens5;tokens6];[tokens7;tokens8]]
  77
  78 If all of the lists tokens contain only one element, we are done.
  79
  80 Otherwise, we focus on tokens1.  For each of its elements, if they are
  81 present in all of the others, then a position is assigned, and if not then
  82 a position is not.  The order of the elements in the other lists is
  83 irrelevant; we just take the first unannotated element that matches.  Once
  84 we are done with the elements of tokens1, we skip to tokens 4 and repeat,
  85 including considering the one-element special case. *)
  86
  87 let pctr = ref 0
  88 let get_p _ =
  89   let c = !pctr in
  90   pctr := c + 1;
  91   let name = ("",Printf.sprintf "p%d" c) in
  92   Ast0.MetaPos(Ast0.make_mcode name,[],Ast.PER)
  93
  94 let process_info l =
  95    let rec loop = function
  96        [] -> ()
  97      | ((f::r)::xs) as a ->
  98          if List.for_all (List.for_all (function e -> List.length e = 1)) a
  99          then
 100            let p = get_p() in
 101            List.iter (List.iter (List.iter (function (_,pos) -> pos := p))) a
 102          else
 103            let all = r @ List.concat xs in
 104            let rec find_first_available a = function
 105                [] -> raise Not_found
 106              | (str,pos)::xs ->
 107                  if str = a && !pos = Ast0.NoMetaPos
 108                  then pos
 109                  else find_first_available a xs in
 110            List.iter
 111              (function (str,pos) ->
 112                match !pos with
 113                  Ast0.NoMetaPos ->
 114                    (try
 115                      let entries = List.map (find_first_available str) all in
 116                      let p = get_p() in
 117                      pos := p;
 118                      List.iter (function pos -> pos := p) entries
 119                    with Not_found -> ())
 120                | _ -> (* already have a variable *) ())
 121              f;
 122            loop xs
 123      | _ -> failwith "bad iso" in
 124    loop l
 125
 126 (* Entry point *)
 127
 128 let process (metavars,alts,name) =
 129   let toks =
 130     List.map (List.map sequence_tokens.VT0.combiner_rec_anything) alts in
 131   process_info toks