Commit | Line | Data |
---|---|---|
9bc82bae C |
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 | ||
c491d8ee C |
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 | ||
34e49164 C |
49 | let drop_spaces s = |
50 | String.concat "" (Str.split (Str.regexp "[ ]+") s) | |
51 | ||
52 | let parse_line fp l n = | |
53 | if List.mem l fp | |
54 | then None | |
55 | else | |
56 | if Str.string_match (Str.regexp "#") l 0 | |
57 | then None (* comment line *) | |
58 | else | |
59 | let top_split = Str.split (Str.regexp ":") l in | |
60 | match top_split with | |
61 | cocci::first::others -> | |
62 | let rec loop tag = function | |
63 | [x] -> | |
64 | let x = | |
65 | String.concat "\\ " (Str.split (Str.regexp "[ ]+") x) in | |
66 | [(tag,x)] | |
67 | | first::rest -> | |
68 | let splitted = Str.split (Str.regexp "[ ]+") first in | |
69 | (match List.rev splitted with | |
70 | new_tag::info -> | |
71 | let rest = loop new_tag rest in | |
413ffc02 | 72 | (tag,String.concat "\\ " (List.rev info))::rest |
34e49164 C |
73 | | _ -> failwith "bad element") |
74 | | _ -> failwith "no data" in | |
75 | Some (cocci,loop (drop_spaces first) others) | |
76 | | _ -> failwith (Printf.sprintf "bad line: %s" l) | |
ae4735db | 77 | |
34e49164 C |
78 | let collect_lines fp i = |
79 | let lines = ref [] in | |
80 | let ln = ref 0 in | |
81 | let rec loop _ = | |
82 | ln := !ln + 1; | |
83 | (match parse_line fp (input_line i) !ln with | |
84 | Some l -> | |
85 | if List.mem l !lines | |
86 | then () | |
87 | else lines := l::!lines | |
88 | | None -> ()); | |
89 | loop() in | |
90 | try loop() with End_of_file -> !lines | |
91 | ||
92 | (* --------------------------------------------------------------------- *) | |
93 | ||
94 | let process_fp fl = | |
95 | let i = open_in fl in | |
96 | let lines = ref ([] : string list) in | |
97 | let rec loop _ = | |
98 | let l = input_line i in | |
99 | (if not(Str.string_match (Str.regexp "#") l 0) | |
100 | then lines := l :: !lines); | |
101 | loop() in | |
102 | (try loop() with End_of_file -> ()); | |
103 | close_in i; | |
104 | !lines | |
105 | ||
106 | (* --------------------------------------------------------------------- *) | |
9f8e26f4 | 107 | (* same info, different categories *) |
34e49164 C |
108 | |
109 | let discard_ambiguous lines = | |
110 | let rec loop = function | |
111 | [] -> [] | |
112 | | (cocci,tags)::rest -> | |
113 | let (same,others) = | |
114 | List.partition | |
115 | (function (cocci2,tags2) -> tags = tags2 && not(cocci = cocci2)) | |
116 | rest in | |
117 | match same with | |
118 | [] -> (cocci,tags)::loop rest | |
119 | | _ -> | |
120 | Printf.printf "ignoring ambiguity:\n"; | |
121 | List.iter | |
122 | (function (cocci,tags) -> | |
123 | Printf.printf "%s: %s\n" cocci | |
124 | (String.concat ", " | |
125 | (List.map | |
126 | (function (tag,tagval) -> | |
127 | Printf.sprintf "%s: %s" tag tagval) | |
128 | tags))) | |
129 | ((cocci,tags)::same); | |
130 | loop others in | |
131 | loop lines | |
132 | ||
133 | (* --------------------------------------------------------------------- *) | |
134 | (* only actually collects the rightmost element into ors *) | |
135 | ||
136 | let split_or (cocci,line) = | |
137 | let rev = List.rev line in | |
138 | (cocci,List.rev(List.tl rev), List.hd rev) | |
139 | ||
140 | let collect_ors fp lines = | |
141 | let rec loop = function | |
142 | [] -> failwith "no lines" | |
143 | | [line] -> | |
144 | let (c,k,v) = split_or line in | |
145 | ((c,k,[v]),[]) | |
146 | | line::xs -> | |
147 | let (c,k,v) = split_or line in | |
148 | let ((c1,k1,v1),rest) = loop xs in | |
978fd7e5 | 149 | if c = c1 && k = k1 && not (k = []) |
34e49164 C |
150 | then |
151 | if List.mem v v1 | |
152 | then ((c1,k1,v1),rest) | |
153 | else ((c1,k1,v::v1),rest) | |
154 | else ((c,k,[v]),((c1,k1,v1)::rest)) in | |
155 | let ((c,k,v),rest) = loop lines in | |
156 | let res = (c,k,v)::rest in | |
157 | List.fold_left | |
158 | (function prev -> | |
159 | function (c,k,v) -> | |
160 | match v with | |
161 | [] -> failwith "not possible" | |
162 | | [x] -> (c,k@v) :: prev | |
163 | | (tag,_)::_ -> | |
91eba41f | 164 | (*let vs = |
34e49164 C |
165 | Printf.sprintf "%s:(%s)" tag |
166 | (String.concat "|" | |
167 | (List.sort compare | |
168 | (List.map (function (_,vl) -> vl) v))) in | |
169 | let attempt = | |
170 | Printf.sprintf "%s: %s %s" c | |
171 | (String.concat " " (List.map (function (k,v) -> k^":"^v) k)) | |
91eba41f C |
172 | vs in*) |
173 | if true (*List.mem attempt fp*) | |
34e49164 C |
174 | then |
175 | let vs = | |
176 | Printf.sprintf "\\\\\\\\\\(%s\\\\\\\\\\)" | |
177 | (String.concat "\\\\\\\\\\|" | |
178 | (List.sort compare | |
179 | (List.map (function (_,vl) -> vl) v))) in | |
180 | (c,k@[(tag,vs)]) :: prev | |
181 | else (List.map (function vi -> (c,k@[vi])) v) @ prev) | |
182 | [] res | |
183 | ||
184 | (* --------------------------------------------------------------------- *) | |
185 | ||
186 | let command s = | |
187 | let _ = Sys.command s in | |
188 | () | |
189 | ||
785a3008 | 190 | let created = ref ([] : (string * (string list ref * out_channel)) list) |
34e49164 C |
191 | |
192 | let mktag n = Printf.sprintf "x%d" n | |
193 | ||
194 | let created_files = ref ([] : (string * int ref) list) | |
195 | ||
196 | let process_line env (cocci,tags) = | |
197 | let files = List.filter (function (c,f) -> c = cocci) env in | |
198 | List.iter | |
199 | (function (_,cocci_file) -> | |
200 | let resdir = Filename.chop_extension cocci_file in | |
201 | (if not(Sys.file_exists cocci_file) | |
202 | then failwith "no cocci file"); | |
203 | let (n,o) = | |
204 | try List.assoc resdir !created | |
205 | with Not_found -> | |
206 | begin | |
785a3008 C |
207 | if Sys.file_exists resdir |
208 | then | |
209 | command | |
210 | (Printf.sprintf | |
211 | "test %s -nt %s && /bin/rm -r -f %s && mkdir %s" | |
212 | cocci_file resdir resdir resdir) | |
213 | else command (Printf.sprintf "mkdir %s" resdir); | |
34e49164 C |
214 | let files = Printf.sprintf "%s/files" resdir in |
215 | let o = open_out files in | |
216 | Printf.fprintf o "all: real_all\n\n"; | |
785a3008 | 217 | let cell = ((ref []),o) in |
34e49164 C |
218 | created := (resdir,cell) :: !created; |
219 | cell | |
220 | end in | |
221 | let temp_file = Filename.temp_file cocci ".cocci" in | |
222 | command (Printf.sprintf "cp %s %s" cocci_file temp_file); | |
223 | let first_tag_val = | |
224 | match tags with | |
225 | [] -> failwith "no tags" | |
226 | | (_,first_tag_val)::_ -> | |
227 | let cell = | |
228 | try List.assoc first_tag_val !created_files | |
229 | with Not_found -> | |
230 | let c = ref (-1) in | |
231 | created_files := (first_tag_val,c)::!created_files; | |
232 | c in | |
233 | cell := !cell + 1; | |
234 | if !cell = 0 | |
235 | then first_tag_val | |
236 | else Printf.sprintf "%s%d" first_tag_val !cell in | |
237 | List.iter | |
238 | (function (tag,tagval) -> | |
239 | command | |
240 | (Printf.sprintf "sed s/%s/%s/ %s > %s_out; cp %s_out %s" | |
241 | tag tagval temp_file temp_file temp_file temp_file)) | |
242 | tags; | |
243 | command | |
244 | (Printf.sprintf "mv %s %s/%s.cocci" temp_file resdir first_tag_val); | |
785a3008 C |
245 | Printf.fprintf o "%s.out:\n\tmono_spatch_linux %s.cocci ${ARGS}\n\n" |
246 | first_tag_val first_tag_val; | |
247 | n := (first_tag_val^".out") :: !n) | |
34e49164 | 248 | files |
ae4735db | 249 | |
34e49164 | 250 | (* --------------------------------------------------------------------- *) |
ae4735db | 251 | |
34e49164 C |
252 | let rec mkenv = function |
253 | [] -> [] | |
254 | | [_] -> failwith "required arguments: file (category x cocci file)*" | |
255 | | category::cocci::rest -> | |
256 | if Filename.check_suffix cocci ".cocci" | |
257 | then (category,cocci)::mkenv rest | |
258 | else failwith "required arguments: file (category x cocci file)*" | |
259 | ||
260 | let rec upto = function | |
261 | 0 -> [] | |
262 | | n -> (mktag (n-1)) :: (upto (n-1)) | |
ae4735db | 263 | |
34e49164 | 264 | let _ = |
9f8e26f4 C |
265 | let (no_ors,args) = |
266 | List.partition (function "-no_ors" -> true | _ -> false) | |
267 | (Array.to_list Sys.argv) in | |
34e49164 | 268 | let (file,fp,env) = |
9f8e26f4 | 269 | match List.tl args with |
34e49164 C |
270 | file::env -> |
271 | let rec loop prev = function | |
272 | [] -> | |
273 | if prev = "" | |
274 | then ([],[]) | |
275 | else ([prev],[]) | |
276 | | x::xs -> | |
277 | try | |
278 | let _ = Str.search_forward (Str.regexp ".cocci") x 0 in | |
279 | if prev = "" | |
280 | then ([],x::xs) | |
281 | else ([],prev::x::xs) | |
282 | with Not_found -> | |
283 | let (fp,env) = loop x xs in | |
284 | if prev = "" | |
285 | then (fp,env) | |
286 | else (prev::fp,env) in | |
287 | let (fp,env) = loop "" env in | |
288 | (file,fp,mkenv env) | |
289 | | _ -> failwith "one argument expected" in | |
290 | let fp = List.fold_left (@) [] (List.map process_fp fp) in | |
291 | let i = open_in file in | |
292 | let lines = collect_lines fp i in | |
9f8e26f4 | 293 | let lines = if no_ors = [] then collect_ors fp lines else lines in |
34e49164 C |
294 | close_in i; |
295 | let lines = discard_ambiguous lines in | |
296 | List.iter (process_line env) lines; | |
297 | List.iter | |
298 | (function (resdir,(n,o)) -> | |
299 | Printf.fprintf o "real_all: %s\n" | |
785a3008 C |
300 | (String.concat " " (List.rev !n)); |
301 | Printf.fprintf o "\tcat %s > completed\n" | |
302 | (String.concat " " (List.rev !n)); | |
34e49164 C |
303 | close_out o) |
304 | !created |