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