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