tools/bridge.ml

   1 (*
   2  * Copyright 2005-2010, 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 (*
  24  * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
  25  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  26  * This file is part of Coccinelle.
  27  *
  28  * Coccinelle is free software: you can redistribute it and/or modify
  29  * it under the terms of the GNU General Public License as published by
  30  * the Free Software Foundation, according to version 2 of the License.
  31  *
  32  * Coccinelle is distributed in the hope that it will be useful,
  33  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  34  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  35  * GNU General Public License for more details.
  36  *
  37  * You should have received a copy of the GNU General Public License
  38  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  39  *
  40  * The authors reserve the right to distribute this or future versions of
  41  * Coccinelle under other licenses.
  42  *)
  43
  44
  45 let drop_spaces s =
  46   String.concat "" (Str.split (Str.regexp "[ ]+") s)
  47
  48 let parse_line fp l n =
  49   if List.mem l fp
  50   then None
  51   else
  52     if Str.string_match (Str.regexp "#") l 0
  53     then None (* comment line *)
  54     else
  55       let top_split = Str.split (Str.regexp ":") l in
  56       match top_split with
  57         cocci::first::others ->
  58           let rec loop tag = function
  59               [x] ->
  60                 let x =
  61                   String.concat "\\ " (Str.split (Str.regexp "[ ]+") x) in
  62                 [(tag,x)]
  63             | first::rest ->
  64                 let splitted = Str.split (Str.regexp "[ ]+") first in
  65                 (match List.rev splitted with
  66                   new_tag::info ->
  67                     let rest = loop new_tag rest in
  68                     (tag,String.concat "\\ " info)::rest
  69                 |       _ -> failwith "bad element")
  70             | _ -> failwith "no data" in
  71           Some (cocci,loop (drop_spaces first) others)
  72       | _ -> failwith (Printf.sprintf "bad line: %s" l)
  73
  74 let collect_lines fp i =
  75   let lines = ref [] in
  76   let ln = ref 0 in
  77   let rec loop _ =
  78     ln := !ln + 1;
  79     (match parse_line fp (input_line i) !ln with
  80       Some l ->
  81         if List.mem l !lines
  82         then ()
  83         else lines := l::!lines
  84     | None -> ());
  85     loop() in
  86   try loop() with End_of_file -> !lines
  87
  88 (* --------------------------------------------------------------------- *)
  89
  90 let process_fp fl =
  91   let i = open_in fl in
  92   let lines = ref ([] : string list) in
  93   let rec loop _ =
  94     let l = input_line i in
  95     (if not(Str.string_match (Str.regexp "#") l 0)
  96     then lines := l :: !lines);
  97     loop() in
  98   (try loop() with End_of_file -> ());
  99   close_in i;
 100   !lines
 101
 102 (* --------------------------------------------------------------------- *)
 103 (* same info, different categories *)
 104
 105 let discard_ambiguous lines =
 106   let rec loop = function
 107       [] -> []
 108     | (cocci,tags)::rest ->
 109         let (same,others) =
 110           List.partition
 111             (function (cocci2,tags2) -> tags = tags2 && not(cocci = cocci2))
 112             rest in
 113         match same with
 114           [] -> (cocci,tags)::loop rest
 115         | _ ->
 116             Printf.printf "ignoring ambiguity:\n";
 117             List.iter
 118               (function (cocci,tags) ->
 119                 Printf.printf "%s: %s\n" cocci
 120                   (String.concat ", "
 121                      (List.map
 122                         (function (tag,tagval) ->
 123                           Printf.sprintf "%s: %s" tag tagval)
 124                         tags)))
 125               ((cocci,tags)::same);
 126             loop others in
 127   loop lines
 128
 129 (* --------------------------------------------------------------------- *)
 130 (* only actually collects the rightmost element into ors *)
 131
 132 let split_or (cocci,line) =
 133   let rev = List.rev line in
 134   (cocci,List.rev(List.tl rev), List.hd rev)
 135
 136 let collect_ors fp lines =
 137   let rec loop = function
 138       [] -> failwith "no lines"
 139     | [line] ->
 140         let (c,k,v) = split_or line in
 141         ((c,k,[v]),[])
 142     | line::xs ->
 143         let (c,k,v) = split_or line in
 144         let ((c1,k1,v1),rest) = loop xs in
 145         if c = c1 && k = k1 && not (k = [])
 146         then
 147           if List.mem v v1
 148           then ((c1,k1,v1),rest)
 149           else ((c1,k1,v::v1),rest)
 150         else ((c,k,[v]),((c1,k1,v1)::rest)) in
 151   let ((c,k,v),rest) = loop lines in
 152   let res = (c,k,v)::rest in
 153   List.fold_left
 154     (function prev ->
 155       function (c,k,v) ->
 156         match v with
 157           [] -> failwith "not possible"
 158         | [x] -> (c,k@v) :: prev
 159         | (tag,_)::_ ->
 160             (*let vs =
 161               Printf.sprintf "%s:(%s)" tag
 162                 (String.concat "|"
 163                    (List.sort compare
 164                       (List.map (function (_,vl) -> vl) v))) in
 165             let attempt =
 166               Printf.sprintf "%s: %s %s" c
 167                 (String.concat " " (List.map (function (k,v) -> k^":"^v) k))
 168                 vs in*)
 169             if true (*List.mem attempt fp*)
 170             then
 171               let vs =
 172                 Printf.sprintf "\\\\\\\\\\(%s\\\\\\\\\\)"
 173                   (String.concat "\\\\\\\\\\|"
 174                      (List.sort compare
 175                         (List.map (function (_,vl) -> vl) v))) in
 176               (c,k@[(tag,vs)]) :: prev
 177             else (List.map (function vi -> (c,k@[vi])) v) @ prev)
 178     [] res
 179
 180 (* --------------------------------------------------------------------- *)
 181
 182 let command s =
 183   let _ = Sys.command s in
 184   ()
 185
 186 let created = ref ([] : (string * (int ref * out_channel)) list)
 187
 188 let mktag n = Printf.sprintf "x%d" n
 189
 190 let created_files = ref ([] : (string * int ref) list)
 191
 192 let process_line env (cocci,tags) =
 193   let files = List.filter (function (c,f) -> c = cocci) env in
 194   List.iter
 195     (function (_,cocci_file) ->
 196       let resdir = Filename.chop_extension cocci_file in
 197       (if not(Sys.file_exists cocci_file)
 198       then failwith "no cocci file");
 199       let (n,o) =
 200         try List.assoc resdir !created
 201         with Not_found ->
 202           begin
 203             command
 204               (Printf.sprintf "/bin/rm -r -f %s; mkdir %s" resdir resdir);
 205             let files = Printf.sprintf "%s/files" resdir in
 206             let o = open_out files in
 207             Printf.fprintf o "all: real_all\n\n";
 208             let cell = ((ref 0),o) in
 209             created := (resdir,cell) :: !created;
 210             cell
 211           end in
 212       let temp_file = Filename.temp_file cocci ".cocci" in
 213       command (Printf.sprintf "cp %s %s" cocci_file temp_file);
 214       let first_tag_val =
 215         match tags with
 216           [] -> failwith "no tags"
 217         | (_,first_tag_val)::_ ->
 218             let cell =
 219               try List.assoc first_tag_val !created_files
 220               with Not_found ->
 221                 let c = ref (-1) in
 222                 created_files := (first_tag_val,c)::!created_files;
 223                 c in
 224             cell := !cell + 1;
 225             if !cell = 0
 226             then first_tag_val
 227             else Printf.sprintf "%s%d" first_tag_val !cell in
 228       List.iter
 229         (function (tag,tagval) ->
 230           command
 231             (Printf.sprintf "sed s/%s/%s/ %s > %s_out; cp %s_out %s"
 232                tag tagval temp_file temp_file temp_file temp_file))
 233         tags;
 234       command
 235         (Printf.sprintf "mv %s %s/%s.cocci" temp_file resdir first_tag_val);
 236       Printf.fprintf o "%s:\n\tmono_spatch_linux %s.cocci ${ARGS}\n\n"
 237         (mktag !n) first_tag_val;
 238       n := !n + 1)
 239     files
 240
 241 (* --------------------------------------------------------------------- *)
 242
 243 let rec mkenv = function
 244     [] -> []
 245   | [_] -> failwith "required arguments: file (category x cocci file)*"
 246   | category::cocci::rest ->
 247       if Filename.check_suffix cocci ".cocci"
 248       then (category,cocci)::mkenv rest
 249       else failwith "required arguments: file (category x cocci file)*"
 250
 251 let rec upto = function
 252     0 -> []
 253   | n -> (mktag (n-1)) :: (upto (n-1))
 254
 255 let _ =
 256   let (no_ors,args) =
 257     List.partition (function "-no_ors" -> true | _ -> false)
 258       (Array.to_list Sys.argv) in
 259   let (file,fp,env) =
 260     match List.tl args with
 261       file::env ->
 262         let rec loop prev = function
 263             [] ->
 264               if prev = ""
 265               then ([],[])
 266               else ([prev],[])
 267           | x::xs ->
 268               try
 269                 let _ = Str.search_forward (Str.regexp ".cocci") x 0 in
 270                 if prev = ""
 271                 then ([],x::xs)
 272                 else ([],prev::x::xs)
 273               with Not_found ->
 274                 let (fp,env) = loop x xs in
 275                 if prev = ""
 276                 then (fp,env)
 277                 else (prev::fp,env) in
 278         let (fp,env) = loop "" env in
 279         (file,fp,mkenv env)
 280     | _ -> failwith "one argument expected" in
 281   let fp = List.fold_left (@) [] (List.map process_fp fp) in
 282   let i = open_in file in
 283   let lines = collect_lines fp i in
 284   let lines = if no_ors = [] then collect_ors fp lines else lines in
 285   close_in i;
 286   let lines = discard_ambiguous lines in
 287   List.iter (process_line env) lines;
 288   List.iter
 289     (function (resdir,(n,o)) ->
 290       Printf.fprintf o "real_all: %s\n"
 291         (String.concat " " (List.rev (upto !n)));
 292       close_out o)
 293     !created