parsing_cocci/iso_compile.ml

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