tools/bridge.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 (*
  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
  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
  72                     (tag,String.concat "\\ " (List.rev info))::rest
  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)
  77
  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 (* --------------------------------------------------------------------- *)
 107 (* same info, different categories *)
 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
 149         if c = c1 && k = k1 && not (k = [])
 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,_)::_ ->
 164             (*let vs =
 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))
 172                 vs in*)
 173             if true (*List.mem attempt fp*)
 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
 190 let created = ref ([] : (string * (string list ref * out_channel)) list)
 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
 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);
 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";
 217             let cell = ((ref []),o) in
 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);
 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)
 248     files
 249
 250 (* --------------------------------------------------------------------- *)
 251
 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))
 263
 264 let _ =
 265   let (no_ors,args) =
 266     List.partition (function "-no_ors" -> true | _ -> false)
 267       (Array.to_list Sys.argv) in
 268   let (file,fp,env) =
 269     match List.tl args with
 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
 293   let lines = if no_ors = [] then collect_ors fp lines else lines in
 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"
 300         (String.concat " " (List.rev !n));
 301       Printf.fprintf o "\tcat %s > completed\n"
 302         (String.concat " " (List.rev !n));
 303       close_out o)
 304     !created