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