parsing_cocci/merge.ml

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