parsing_cocci/merge.ml

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