tools/bridge.ml

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