File: merge.ml

package info (click to toggle)
coccinelle 1.0.8.deb-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 26,148 kB
  • sloc: ml: 136,392; ansic: 23,594; sh: 2,189; makefile: 2,157; perl: 1,576; lisp: 840; python: 823; awk: 70; csh: 12
file content (196 lines) | stat: -rw-r--r-- 6,719 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
(*
 * This file is part of Coccinelle, licensed under the terms of the GPL v2.
 * See copyright.txt in the Coccinelle source code for more information.
 * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr
 *)

(* given parsed minus code and a stream of + code, figure out where to put
the + code in the mcode of the minus code *)

(* Need to be able to find the nearest inhabited line rather than just
adding 1 or subtracting 1 to the actual line number.  This is an issue for
plus.ml as well.  This problem is dealt with by the logical line field,
which is not incremented for blank lines. *)

module Ast = Ast_cocci
module Ast0 = Ast0_cocci
module V0 = Visitor_ast0

(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
(* Step 1: convert minus/context code to an ordered stream of tokens *)

type position =
    Minus of Ast.info * Ast.anything list list ref
  | Context of Ast.info * Ast.anything Ast.befaft ref
  | Bad of Ast.info

let mcode = function
    (_,_,Ast.MINUS(info,plus_stream)) -> [Minus (info,plus_stream)]
  | (_,_,Ast.CONTEXT(info,plus_stream)) -> [Context (info,plus_stream)]
  | _ -> failwith "not possible 1"

let bad_mcode = function
    (_,_,Ast.MINUS(info,plus_stream)) -> Bad(info)
  | (_,_,Ast.CONTEXT(info,plus_stream)) -> Bad(info)
  | _ -> failwith "not possible 2"

let make_bad l =
  List.map
    (function
	Minus(info,plus_stream) -> Bad(info)
      |	Context(info,plus_stream) -> Bad(info)
      |	x -> x)
    l

(* --------------------------------------------------------------------- *)
(* combiner info *)

let bind x y = x @ y
let option_default = []

(* --------------------------------------------------------------------- *)

let get_option f = function
    Some x -> f x
  | None -> option_default

let ident recursor k i = k i (* nothing special to do *)

let expression recursor k e =
  match Ast0.unwrap e with
    Ast0.Edots(dots,whencode) | Ast0.Ecircles(dots,whencode)
  | Ast0.Estars(dots,whencode) ->
      (bad_mcode dots) ::
      (get_option (function x -> make_bad(recursor.V0.combiner_expression x))
	 whencode)
  | _ -> k e

let donothing recursor k ft = k ft

(* needs a case for things to which new code cannot be attached *)
let parameterTypeDef recursor k p =
  match Ast0.unwrap p with
    Ast0.Pdots(dots) -> [bad_mcode dots]
  | Ast0.Pcircles(dots) -> [bad_mcode dots]
  | _ -> k p

let statement recursor k s =
  match Ast0.unwrap s with
    Ast0.Dots(d,whencode) | Ast0.Circles(d,whencode)
  | Ast0.Stars(d,whencode) ->
      (bad_mcode d) ::
      (get_option
	 (function x ->
	   make_bad(recursor.V0.combiner_statement_dots x))
	 whencode)
  | _ -> k s

let top_level recursor k t =
  match Ast0.unwrap t with
    Ast0.FILEINFO(old_file,new_file) ->
      [bad_mcode old_file;bad_mcode new_file]
  | Ast0.ERRORWORDS(exps) ->
      make_bad (List.concat (List.map recursor.V0.combiner_expression exps))
  | _ -> k t

let recursor =
  V0.combiner bind option_default
    mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
    donothing donothing donothing
    ident expression donothing donothing parameterTypeDef donothing
    statement top_level

let rule code = List.concat (List.map recursor.V0.combiner_top_level code)

(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
(* Step 2: merge the plus stream with the minus/context tokens *)

(* Mcode *)

let get_start l =
  let (_,_,_,start,_) = List.hd (List.hd l) in
  start

let get_finish l =
  let (_,_,_,_,finish) = List.hd (List.rev (List.hd (List.rev l))) in
  finish

let get_real_start l =
  let (_,start,_,_,_) = List.hd (List.hd l) in
  start

let get_real_finish l =
  let (_,_,finish,_,_) = List.hd (List.rev (List.hd (List.rev l))) in
  finish

let get_minus_next_line mline = function
    [] -> mline + 1
  | Bad(info)::xs -> info.Ast.logical_line
  | Minus(info,_)::xs -> info.Ast.logical_line
  | Context(info,_)::xs -> info.Ast.logical_line

let drop_lines l = List.map (List.map (function (x,_,_,_,_) -> x)) l

let rec merge minus_stream plus_stream =
  match (minus_stream,plus_stream) with
    (_,[]) -> ()
  | ([],plus::plus_stream) ->
      failwith
	(Printf.sprintf
	   "minus stream ran out before plus stream\n(plus code begins on line %d)\n"
	   (get_real_start plus))
  | (Bad(info)::minus_stream,plus::plus_stream) ->
      let pfinish = get_finish plus in
      if info.Ast.logical_line > pfinish
      then
	failwith
	  (Printf.sprintf
	     "plus code starting on line %d has no minus or context code to attach to\n"
	     (get_real_start plus))
      else merge minus_stream (plus::plus_stream)
  | (((Minus(info,cell)::minus_stream) as all_minus),plus::plus_stream) ->
      let mline = info.Ast.logical_line in
      let mnext_line = get_minus_next_line mline minus_stream in
      let pstart = get_start plus in
      let pfinish = get_finish plus in
      if pstart < mline && pfinish > mline
      then (cell := (drop_lines plus) @ !cell; merge minus_stream plus_stream)
      else if pfinish + 1 = mline
      then (cell := (drop_lines plus) @ !cell; merge all_minus plus_stream)
      else if not(mline = mnext_line) && (pstart - 1 = mline)
      then (cell := !cell @ (drop_lines plus); merge minus_stream plus_stream)
      else if pfinish < mline
      then
	Printf.printf "failed to merge + code between lines %d and %d"
	  (get_real_start plus) (get_real_finish plus)
      else merge minus_stream (plus::plus_stream)
  | (((Context(info,cell)::minus_stream) as all_minus),plus::plus_stream) ->
      let mline = info.Ast.logical_line in
      let mnext_line = get_minus_next_line mline minus_stream in
      let pstart = get_start plus in
      let pfinish = get_finish plus in
      if pfinish + 1 = mline
      then (cell := Ast.BEFORE (drop_lines plus); merge all_minus plus_stream)
      else if not(mline = mnext_line) && (pstart - 1 = mline)
      then
	begin
	  (match !cell with
	    Ast.BEFORE x -> cell := Ast.BEFOREAFTER (x,drop_lines plus)
	  | _ -> cell := Ast.AFTER (drop_lines plus));
	  merge minus_stream plus_stream
	end
      else if pfinish < mline
      then
	Printf.printf "failed to merge + code between lines %d and %d"
	  (get_real_start plus) (get_real_finish plus)
      else merge minus_stream (plus::plus_stream)

(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
(* Entry point *)

let do_merge minus plus_stream =
  let minus_tokens = rule minus in
  merge minus_tokens plus_stream