parsing_cocci/merge.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 (* given parsed minus code and a stream of + code, figure out where to put
  28 the + code in the mcode of the minus code *)
  29
  30 (* Need to be able to find the nearest inhabited line rather than just
  31 adding 1 or subtracting 1 to the actual line number.  This is an issue for
  32 plus.ml as well.  This problem is dealt with by the logical line field,
  33 which is not incremented for blank lines. *)
  34
  35 module Ast = Ast_cocci
  36 module Ast0 = Ast0_cocci
  37 module V0 = Visitor_ast0
  38
  39 (* --------------------------------------------------------------------- *)
  40 (* --------------------------------------------------------------------- *)
  41 (* Step 1: convert minus/context code to an ordered stream of tokens *)
  42
  43 type position =
  44     Minus of Ast.info * Ast.anything list list ref
  45   | Context of Ast.info * Ast.anything Ast.befaft ref
  46   | Bad of Ast.info
  47
  48 let mcode = function
  49     (_,_,Ast.MINUS(info,plus_stream)) -> [Minus (info,plus_stream)]
  50   | (_,_,Ast.CONTEXT(info,plus_stream)) -> [Context (info,plus_stream)]
  51   | _ -> failwith "not possible 1"
  52
  53 let bad_mcode = function
  54     (_,_,Ast.MINUS(info,plus_stream)) -> Bad(info)
  55   | (_,_,Ast.CONTEXT(info,plus_stream)) -> Bad(info)
  56   | _ -> failwith "not possible 2"
  57
  58 let make_bad l =
  59   List.map
  60     (function
  61         Minus(info,plus_stream) -> Bad(info)
  62       | Context(info,plus_stream) -> Bad(info)
  63       | x -> x)
  64     l
  65
  66 (* --------------------------------------------------------------------- *)
  67 (* combiner info *)
  68
  69 let bind x y = x @ y
  70 let option_default = []
  71
  72 (* --------------------------------------------------------------------- *)
  73
  74 let get_option f = function
  75     Some x -> f x
  76   | None -> option_default
  77
  78 let ident recursor k i = k i (* nothing special to do *)
  79
  80 let expression recursor k e =
  81   match Ast0.unwrap e with
  82     Ast0.Edots(dots,whencode) | Ast0.Ecircles(dots,whencode)
  83   | Ast0.Estars(dots,whencode) ->
  84       (bad_mcode dots) ::
  85       (get_option (function x -> make_bad(recursor.V0.combiner_expression x))
  86          whencode)
  87   | _ -> k e
  88
  89 let donothing recursor k ft = k ft
  90
  91 (* needs a case for things to which new code cannot be attached *)
  92 let parameterTypeDef recursor k p =
  93   match Ast0.unwrap p with
  94     Ast0.Pdots(dots) -> [bad_mcode dots]
  95   | Ast0.Pcircles(dots) -> [bad_mcode dots]
  96   | _ -> k p
  97
  98 let statement recursor k s =
  99   match Ast0.unwrap s with
 100     Ast0.Dots(d,whencode) | Ast0.Circles(d,whencode)
 101   | Ast0.Stars(d,whencode) ->
 102       (bad_mcode d) ::
 103       (get_option
 104          (function x ->
 105            make_bad(recursor.V0.combiner_statement_dots x))
 106          whencode)
 107   | _ -> k s
 108
 109 let top_level recursor k t =
 110   match Ast0.unwrap t with
 111     Ast0.FILEINFO(old_file,new_file) ->
 112       [bad_mcode old_file;bad_mcode new_file]
 113   | Ast0.ERRORWORDS(exps) ->
 114       make_bad (List.concat (List.map recursor.V0.combiner_expression exps))
 115   | _ -> k t
 116
 117 let recursor =
 118   V0.combiner bind option_default
 119     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 120     donothing donothing donothing
 121     ident expression donothing donothing parameterTypeDef donothing
 122     statement top_level
 123
 124 let rule code = List.concat (List.map recursor.V0.combiner_top_level code)
 125
 126 (* --------------------------------------------------------------------- *)
 127 (* --------------------------------------------------------------------- *)
 128 (* Step 2: merge the plus stream with the minus/context tokens *)
 129
 130 (* Mcode *)
 131
 132 let get_start l =
 133   let (_,_,_,start,_) = List.hd (List.hd l) in
 134   start
 135
 136 let get_finish l =
 137   let (_,_,_,_,finish) = List.hd (List.rev (List.hd (List.rev l))) in
 138   finish
 139
 140 let get_real_start l =
 141   let (_,start,_,_,_) = List.hd (List.hd l) in
 142   start
 143
 144 let get_real_finish l =
 145   let (_,_,finish,_,_) = List.hd (List.rev (List.hd (List.rev l))) in
 146   finish
 147
 148 let get_minus_next_line mline = function
 149     [] -> mline + 1
 150   | Bad(info)::xs -> info.Ast.logical_line
 151   | Minus(info,_)::xs -> info.Ast.logical_line
 152   | Context(info,_)::xs -> info.Ast.logical_line
 153
 154 let drop_lines l = List.map (List.map (function (x,_,_,_,_) -> x)) l
 155
 156 let rec merge minus_stream plus_stream =
 157   match (minus_stream,plus_stream) with
 158     (_,[]) -> ()
 159   | ([],plus::plus_stream) ->
 160       failwith
 161         (Printf.sprintf
 162            "minus stream ran out before plus stream\n(plus code begins on line %d)\n"
 163            (get_real_start plus))
 164   | (Bad(info)::minus_stream,plus::plus_stream) ->
 165       let pfinish = get_finish plus in
 166       if info.Ast.logical_line > pfinish
 167       then
 168         failwith
 169           (Printf.sprintf
 170              "plus code starting on line %d has no minus or context code to attach to\n"
 171              (get_real_start plus))
 172       else merge minus_stream (plus::plus_stream)
 173   | (((Minus(info,cell)::minus_stream) as all_minus),plus::plus_stream) ->
 174       let mline = info.Ast.logical_line in
 175       let mnext_line = get_minus_next_line mline minus_stream in
 176       let pstart = get_start plus in
 177       let pfinish = get_finish plus in
 178       if pstart < mline && pfinish > mline
 179       then (cell := (drop_lines plus) @ !cell; merge minus_stream plus_stream)
 180       else if pfinish + 1 = mline
 181       then (cell := (drop_lines plus) @ !cell; merge all_minus plus_stream)
 182       else if not(mline = mnext_line) && (pstart - 1 = mline)
 183       then (cell := !cell @ (drop_lines plus); merge minus_stream plus_stream)
 184       else if pfinish < mline
 185       then
 186         Printf.printf "failed to merge + code between lines %d and %d"
 187           (get_real_start plus) (get_real_finish plus)
 188       else merge minus_stream (plus::plus_stream)
 189   | (((Context(info,cell)::minus_stream) as all_minus),plus::plus_stream) ->
 190       let mline = info.Ast.logical_line in
 191       let mnext_line = get_minus_next_line mline minus_stream in
 192       let pstart = get_start plus in
 193       let pfinish = get_finish plus in
 194       if pfinish + 1 = mline
 195       then (cell := Ast.BEFORE (drop_lines plus); merge all_minus plus_stream)
 196       else if not(mline = mnext_line) && (pstart - 1 = mline)
 197       then
 198         begin
 199           (match !cell with
 200             Ast.BEFORE x -> cell := Ast.BEFOREAFTER (x,drop_lines plus)
 201           | _ -> cell := Ast.AFTER (drop_lines plus));
 202           merge minus_stream plus_stream
 203         end
 204       else if pfinish < mline
 205       then
 206         Printf.printf "failed to merge + code between lines %d and %d"
 207           (get_real_start plus) (get_real_finish plus)
 208       else merge minus_stream (plus::plus_stream)
 209
 210 (* --------------------------------------------------------------------- *)
 211 (* --------------------------------------------------------------------- *)
 212 (* Entry point *)
 213
 214 let do_merge minus plus_stream =
 215   let minus_tokens = rule minus in
 216   merge minus_tokens plus_stream