parsing_cocci/iso_compile.ml

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