parsing_cocci/merge.ml

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