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 module V0 = Visitor_ast0
  26 module VT0 = Visitor_ast0_types
  27 module Ast0 = Ast0_cocci
  28 module Ast = Ast_cocci
  29
  30 (* Detects where position variables can be present in the match of an
  31 isomorpshims.  This is allowed if all elements of an isomorphism have only
  32 one token or if we can somehow match up equal tokens of all of the
  33 isomorphic variants. *)
  34
  35 let sequence_tokens =
  36   let mcode x =
  37     (* sort of unpleasant to convert the token representation to a string
  38        but we can't make a list of mcodes otherwise because the types are all
  39        different *)
  40     [(Common.dump (Ast0.unwrap_mcode x),Ast0.get_pos_ref x)] in
  41   let donothing r k e = k e in
  42   let bind x y = x @ y in
  43   let option_default = [] in
  44   V0.flat_combiner bind option_default
  45     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
  46     donothing donothing donothing donothing donothing donothing
  47     donothing donothing
  48     donothing donothing donothing donothing donothing donothing donothing
  49
  50 (* In general, we will get a list of lists:
  51
  52 [[tokens1;tokens2;tokens3];[tokens4;tokens5;tokens6];[tokens7;tokens8]]
  53
  54 If all of the lists tokens contain only one element, we are done.
  55
  56 Otherwise, we focus on tokens1.  For each of its elements, if they are
  57 present in all of the others, then a position is assigned, and if not then
  58 a position is not.  The order of the elements in the other lists is
  59 irrelevant; we just take the first unannotated element that matches.  Once
  60 we are done with the elements of tokens1, we skip to tokens 4 and repeat,
  61 including considering the one-element special case. *)
  62
  63 let pctr = ref 0
  64 let get_p _ =
  65   let c = !pctr in
  66   pctr := c + 1;
  67   let name = ("",Printf.sprintf "p%d" c) in
  68   Ast0.MetaPos(Ast0.make_mcode name,[],Ast.PER)
  69
  70 let process_info l =
  71    let rec loop = function
  72        [] -> ()
  73      | ((f::r)::xs) as a ->
  74          if List.for_all (List.for_all (function e -> List.length e = 1)) a
  75          then
  76            let p = get_p() in
  77            List.iter (List.iter (List.iter (function (_,pos) -> pos := p))) a
  78          else
  79            let all = r @ List.concat xs in
  80            let rec find_first_available a = function
  81                [] -> raise Not_found
  82              | (str,pos)::xs ->
  83                  if str = a && !pos = Ast0.NoMetaPos
  84                  then pos
  85                  else find_first_available a xs in
  86            List.iter
  87              (function (str,pos) ->
  88                match !pos with
  89                  Ast0.NoMetaPos ->
  90                    (try
  91                      let entries = List.map (find_first_available str) all in
  92                      let p = get_p() in
  93                      pos := p;
  94                      List.iter (function pos -> pos := p) entries
  95                    with Not_found -> ())
  96                | _ -> (* already have a variable *) ())
  97              f;
  98            loop xs
  99      | _ -> failwith "bad iso" in
 100    loop l
 101
 102 (* Entry point *)
 103
 104 let process (metavars,alts,name) =
 105   let toks =
 106     List.map (List.map sequence_tokens.VT0.combiner_rec_anything) alts in
 107   process_info toks