tools/bridge.ml

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