parsing_cocci/merge.ml

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