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 # 0 "./merge.ml"
  28 (*
  29  * Copyright 2012, INRIA
  30  * Julia Lawall, Gilles Muller
  31  * Copyright 2010-2011, INRIA, University of Copenhagen
  32  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  33  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  34  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  35  * This file is part of Coccinelle.
  36  *
  37  * Coccinelle is free software: you can redistribute it and/or modify
  38  * it under the terms of the GNU General Public License as published by
  39  * the Free Software Foundation, according to version 2 of the License.
  40  *
  41  * Coccinelle is distributed in the hope that it will be useful,
  42  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  43  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  44  * GNU General Public License for more details.
  45  *
  46  * You should have received a copy of the GNU General Public License
  47  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  48  *
  49  * The authors reserve the right to distribute this or future versions of
  50  * Coccinelle under other licenses.
  51  *)
  52
  53
  54 # 0 "./merge.ml"
  55 (* given parsed minus code and a stream of + code, figure out where to put
  56 the + code in the mcode of the minus code *)
  57
  58 (* Need to be able to find the nearest inhabited line rather than just
  59 adding 1 or subtracting 1 to the actual line number.  This is an issue for
  60 plus.ml as well.  This problem is dealt with by the logical line field,
  61 which is not incremented for blank lines. *)
  62
  63 module Ast = Ast_cocci
  64 module Ast0 = Ast0_cocci
  65 module V0 = Visitor_ast0
  66
  67 (* --------------------------------------------------------------------- *)
  68 (* --------------------------------------------------------------------- *)
  69 (* Step 1: convert minus/context code to an ordered stream of tokens *)
  70
  71 type position =
  72     Minus of Ast.info * Ast.anything list list ref
  73   | Context of Ast.info * Ast.anything Ast.befaft ref
  74   | Bad of Ast.info
  75
  76 let mcode = function
  77     (_,_,Ast.MINUS(info,plus_stream)) -> [Minus (info,plus_stream)]
  78   | (_,_,Ast.CONTEXT(info,plus_stream)) -> [Context (info,plus_stream)]
  79   | _ -> failwith "not possible 1"
  80
  81 let bad_mcode = function
  82     (_,_,Ast.MINUS(info,plus_stream)) -> Bad(info)
  83   | (_,_,Ast.CONTEXT(info,plus_stream)) -> Bad(info)
  84   | _ -> failwith "not possible 2"
  85
  86 let make_bad l =
  87   List.map
  88     (function
  89         Minus(info,plus_stream) -> Bad(info)
  90       | Context(info,plus_stream) -> Bad(info)
  91       | x -> x)
  92     l
  93
  94 (* --------------------------------------------------------------------- *)
  95 (* combiner info *)
  96
  97 let bind x y = x @ y
  98 let option_default = []
  99
 100 (* --------------------------------------------------------------------- *)
 101
 102 let get_option f = function
 103     Some x -> f x
 104   | None -> option_default
 105
 106 let ident recursor k i = k i (* nothing special to do *)
 107
 108 let expression recursor k e =
 109   match Ast0.unwrap e with
 110     Ast0.Edots(dots,whencode) | Ast0.Ecircles(dots,whencode)
 111   | Ast0.Estars(dots,whencode) ->
 112       (bad_mcode dots) ::
 113       (get_option (function x -> make_bad(recursor.V0.combiner_expression x))
 114          whencode)
 115   | _ -> k e
 116
 117 let donothing recursor k ft = k ft
 118
 119 (* needs a case for things to which new code cannot be attached *)
 120 let parameterTypeDef recursor k p =
 121   match Ast0.unwrap p with
 122     Ast0.Pdots(dots) -> [bad_mcode dots]
 123   | Ast0.Pcircles(dots) -> [bad_mcode dots]
 124   | _ -> k p
 125
 126 let statement recursor k s =
 127   match Ast0.unwrap s with
 128     Ast0.Dots(d,whencode) | Ast0.Circles(d,whencode)
 129   | Ast0.Stars(d,whencode) ->
 130       (bad_mcode d) ::
 131       (get_option
 132          (function x ->
 133            make_bad(recursor.V0.combiner_statement_dots x))
 134          whencode)
 135   | _ -> k s
 136
 137 let top_level recursor k t =
 138   match Ast0.unwrap t with
 139     Ast0.FILEINFO(old_file,new_file) ->
 140       [bad_mcode old_file;bad_mcode new_file]
 141   | Ast0.ERRORWORDS(exps) ->
 142       make_bad (List.concat (List.map recursor.V0.combiner_expression exps))
 143   | _ -> k t
 144
 145 let recursor =
 146   V0.combiner bind option_default
 147     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 148     donothing donothing donothing
 149     ident expression donothing donothing parameterTypeDef donothing
 150     statement top_level
 151
 152 let rule code = List.concat (List.map recursor.V0.combiner_top_level code)
 153
 154 (* --------------------------------------------------------------------- *)
 155 (* --------------------------------------------------------------------- *)
 156 (* Step 2: merge the plus stream with the minus/context tokens *)
 157
 158 (* Mcode *)
 159
 160 let get_start l =
 161   let (_,_,_,start,_) = List.hd (List.hd l) in
 162   start
 163
 164 let get_finish l =
 165   let (_,_,_,_,finish) = List.hd (List.rev (List.hd (List.rev l))) in
 166   finish
 167
 168 let get_real_start l =
 169   let (_,start,_,_,_) = List.hd (List.hd l) in
 170   start
 171
 172 let get_real_finish l =
 173   let (_,_,finish,_,_) = List.hd (List.rev (List.hd (List.rev l))) in
 174   finish
 175
 176 let get_minus_next_line mline = function
 177     [] -> mline + 1
 178   | Bad(info)::xs -> info.Ast.logical_line
 179   | Minus(info,_)::xs -> info.Ast.logical_line
 180   | Context(info,_)::xs -> info.Ast.logical_line
 181
 182 let drop_lines l = List.map (List.map (function (x,_,_,_,_) -> x)) l
 183
 184 let rec merge minus_stream plus_stream =
 185   match (minus_stream,plus_stream) with
 186     (_,[]) -> ()
 187   | ([],plus::plus_stream) ->
 188       failwith
 189         (Printf.sprintf
 190            "minus stream ran out before plus stream\n(plus code begins on line %d)\n"
 191            (get_real_start plus))
 192   | (Bad(info)::minus_stream,plus::plus_stream) ->
 193       let pfinish = get_finish plus in
 194       if info.Ast.logical_line > pfinish
 195       then
 196         failwith
 197           (Printf.sprintf
 198              "plus code starting on line %d has no minus or context code to attach to\n"
 199              (get_real_start plus))
 200       else merge minus_stream (plus::plus_stream)
 201   | (((Minus(info,cell)::minus_stream) as all_minus),plus::plus_stream) ->
 202       let mline = info.Ast.logical_line in
 203       let mnext_line = get_minus_next_line mline minus_stream in
 204       let pstart = get_start plus in
 205       let pfinish = get_finish plus in
 206       if pstart < mline && pfinish > mline
 207       then (cell := (drop_lines plus) @ !cell; merge minus_stream plus_stream)
 208       else if pfinish + 1 = mline
 209       then (cell := (drop_lines plus) @ !cell; merge all_minus plus_stream)
 210       else if not(mline = mnext_line) && (pstart - 1 = mline)
 211       then (cell := !cell @ (drop_lines plus); merge minus_stream plus_stream)
 212       else if pfinish < mline
 213       then
 214         Printf.printf "failed to merge + code between lines %d and %d"
 215           (get_real_start plus) (get_real_finish plus)
 216       else merge minus_stream (plus::plus_stream)
 217   | (((Context(info,cell)::minus_stream) as all_minus),plus::plus_stream) ->
 218       let mline = info.Ast.logical_line in
 219       let mnext_line = get_minus_next_line mline minus_stream in
 220       let pstart = get_start plus in
 221       let pfinish = get_finish plus in
 222       if pfinish + 1 = mline
 223       then (cell := Ast.BEFORE (drop_lines plus); merge all_minus plus_stream)
 224       else if not(mline = mnext_line) && (pstart - 1 = mline)
 225       then
 226         begin
 227           (match !cell with
 228             Ast.BEFORE x -> cell := Ast.BEFOREAFTER (x,drop_lines plus)
 229           | _ -> cell := Ast.AFTER (drop_lines plus));
 230           merge minus_stream plus_stream
 231         end
 232       else if pfinish < mline
 233       then
 234         Printf.printf "failed to merge + code between lines %d and %d"
 235           (get_real_start plus) (get_real_finish plus)
 236       else merge minus_stream (plus::plus_stream)
 237
 238 (* --------------------------------------------------------------------- *)
 239 (* --------------------------------------------------------------------- *)
 240 (* Entry point *)
 241
 242 let do_merge minus plus_stream =
 243   let minus_tokens = rule minus in
 244   merge minus_tokens plus_stream